From b7390f7e04f2e10cbadeb0c7e146c7485981905c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Apr 2022 14:25:43 -0600 Subject: [PATCH 001/213] Makes set_u_at_v and set_v_at_u public --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index fb969953c4..367cf44d58 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -34,7 +34,7 @@ module MOM_set_visc #include public set_viscous_BBL, set_viscous_ML, set_visc_init, set_visc_end -public set_visc_register_restarts +public set_visc_register_restarts, set_u_at_v, set_v_at_u ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with From 9c103f1f9701796005e9a1fecee2d72e1a7daaa5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Apr 2022 16:43:28 -0600 Subject: [PATCH 002/213] First draft for fpmix --- src/core/MOM_dynamics_split_RK2.F90 | 78 ++- .../vertical/MOM_vert_friction.F90 | 610 ++++++++++++++++++ 2 files changed, 687 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 06d828de96..8c3612f50b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -68,6 +68,9 @@ module MOM_dynamics_split_RK2 use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF +use MOM_CVMix_KPP, only : KPP_get_BLD, KPP_CS +use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS +use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member implicit none ; private @@ -131,6 +134,8 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. + type(KPP_CS), pointer :: KPP_CSp => NULL() !< KPP control structure needed to ge + type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< ePBL control structure real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean !! to the seafloor [R L Z T-2 ~> Pa] @@ -159,10 +164,12 @@ module MOM_dynamics_split_RK2 !! Euler (1) [nondim]. 0 is often used. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_OBC !< If true, do debugging calls for open boundary conditions. + logical :: fpmix !< If true, apply profiles of MTM flux magnitude and direction. logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs + integer :: id_uold = -1, id_vold = -1 integer :: id_uh = -1, id_vh = -1 integer :: id_umo = -1, id_vmo = -1 integer :: id_umo_2d = -1, id_vmo_2d = -1 @@ -320,6 +327,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uold + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vold + ! uold and vold are the velocities before vert_visc is applied. These arrays + ! are only used if fpmix is enabled [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are @@ -348,8 +360,9 @@ 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, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. - + logical :: LU_pred ! Controls if it is predictor step or not logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -629,10 +642,41 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif + + if (CS%fpmix) then + uold(:,:,:) = 0.0 + vold(:,:,:) = 0.0 + do k = 1, nz + do j = js , je + do I = Isq, Ieq + uold(I,j,k) = up(I,j,k) + enddo + enddo + do J = Jsq, Jeq + do i = is, ie + vold(i,J,k) = vp(i,J,k) + enddo + enddo + enddo + endif + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + + if (CS%fpmix) then + LU_pred = .true. + hbl(:,:) = 0.0 + if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) + if (ASSOCIATED(CS%energetic_PBL_CSp)) & + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, m_to_MLD_units=GV%m_to_H) + call vertFPmix(LU_pred, up, vp, uold, vold, hbl, h, forces, & + dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + endif + if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -847,9 +891,36 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) + + if (CS%fpmix) then + uold(:,:,:) = 0.0 + vold(:,:,:) = 0.0 + do k = 1, nz + do j = js , je + do I = Isq, Ieq + uold(I,j,k) = u(I,j,k) + enddo + enddo + do J = Jsq, Jeq + do i = is, ie + vold(i,J,k) = v(i,J,k) + enddo + enddo + enddo + endif + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) + + if (CS%fpmix) then + LU_pred = .false. + call vertFPmix(LU_pred, u, v, uold, vold, hbl, h, forces, dt, & + G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & + CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + endif + if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) @@ -914,6 +985,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo + if (CS%fpmix) then + if (CS%id_uold > 0) call post_data(CS%id_uold , uold, CS%diag) + if (CS%id_vold > 0) call post_data(CS%id_vold , vold, CS%diag) + endif + ! The time-averaged free surface height has already been set by the last call to btstep. ! Deallocate this memory to avoid a memory leak. ### We should revisit how this array is declared. -RWH diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d384500c3d..d5a7aa9804 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -3,6 +3,7 @@ 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_domains, only : pass_vector, Scalar_Pair 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 @@ -31,6 +32,7 @@ module MOM_vert_friction public vertvisc, vertvisc_remnant, vertvisc_coef public vertvisc_limit_vel, vertvisc_init, vertvisc_end public updateCFLtruncationValue +public vertFPmix ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -126,6 +128,9 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 + integer :: id_FPmask_u = -1, id_FPmask_v = -1 , id_FPhbl_u = -1, id_FPhbl_v = -1 + integer :: id_tauFP_u = -1, id_tauFP_v = -1 , id_FPtau2x_u = -1, id_FPtau2x_v = -1 + integer :: id_FPtau2s_u = -1, id_FPtau2s_v = -1, id_FPtau2w_u = -1, id_FPtau2w_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 @@ -142,6 +147,579 @@ module MOM_vert_friction contains +!> Add nonlocal momentum flux profile increments +!! TODO: add more description +subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OBC) ! FPmix + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ui !< Zonal velocity after vertvisc [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vi !< Meridional velocity after vertvisc [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uold !< Old Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vold !< Old Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: hbl_h ! boundary layer depth + logical, intent(inout) :: LU_pred !w predictor step or NOT + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure + type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + + ! local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: mask3d_u !Test Plots @ 3-D centers + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: mask3d_v + real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u !2-D + real, dimension(SZI_(G),SZJB_(G)) :: hbl_v + integer, dimension(SZIB_(G),SZJ_(G)) :: kbl_u + integer, dimension(SZI_(G),SZJB_(G)) :: kbl_v + real, dimension(SZI_(G),SZJ_(G)) :: ustar2_h !2-D surface + real, dimension(SZIB_(G),SZJ_(G)) :: ustar2_u + real, dimension(SZI_(G),SZJB_(G)) :: ustar2_v + real, dimension(SZIB_(G),SZJ_(G)) :: taux_u + real, dimension(SZI_(G),SZJB_(G)) :: tauy_v + real, dimension(SZIB_(G),SZJ_(G)) :: tauy_u + real, dimension(SZI_(G),SZJB_(G)) :: taux_v + real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u + real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tau_u !3-D interfaces + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tau_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauxDG_u + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauyDG_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauxDG_v + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauyDG_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2x_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2x_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2s_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2s_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2w_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2w_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_s2x_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_s2x_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_s2w_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_s2w_v + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: du_rot !3-D centers + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: dv_rot + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: vi_u + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: ui_v + + real :: tauxDG, tauyDG, tauxDGup, tauyDGup, ustar2, MAXinc, MINthick + real :: du, dv, du_v, dv_u , dup, dvp , uZero, vZero + real :: fEQband, Cemp_SS , Cemp_LS , Cemp_CG, Cemp_DG , Wgt_SS + real :: tauNLup, tauNLdn, tauNL_CG, tauNL_DG, tauNL_X, tauNL_Y, tau_MAG + real :: pi, tmp, cos_tmp, sin_tmp, depth, taux, tauy, tauk, tauxI , tauyI, sign_f + real :: tauxh, tauyh, tauh, omega_s2xh, omega_s2wh, omega_tau2xh, omega_tau2wh + real :: taux0, tauy0, tau0, sigma, G_sig, Wind_x, Wind_y, omega_w2s, omega_tau2s,omega_s2x + real :: omega_tau2x, omega_tau2w, omega_SS, omega_LS, omega_tmp, omega_s2xI, omega_s2w + integer :: kblmin, kbld, kp, km, kp1, L19 ,jNseam + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + is = G%isc ; ie = G%iec; js = G%jsc; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke + + pi = 4. * atan2(1.,1.) + L19 = 1 !w Options A = 1, B = 2, C = 3 + Cemp_CG = 3.6 !w L91 cross-gradient + Cemp_DG = 1.0 !w L91 down-gradient + MAXinc = -1.0 !w if positive + MINthick= 0.01 !w GV%H_subroundoff !w 0.5 + kblmin = 1 + jNseam = 457 !w north seam = SZJ_(G) + +if(LU_pred ) then !w predictor step only, surface forcing + ustar2_h(:,:) = 0. + do j = js,je !w ?GMM -1,+1 with forces% + do i = is,ie + ustar2_h(i,j) = forces%ustar(i,j) * forces%ustar(i,j) + !w omega_w2x_h(i,j) = forces%omega_w2x(i,j) + enddo + enddo + call pass_var(ustar2_h ,G%Domain) ! update halos ?GMM + call pass_var( hbl_h ,G%Domain) + +! SURFACE ustar2 and x-stress to u points and ustar2 and y-stress to v points + ustar2_u(:,:) = 0. + ustar2_v(:,:) = 0. + hbl_u(:,:) = 0. + hbl_v(:,:) = 0. + taux_u(:,:) = 0. + tauy_v(:,:) = 0. + do j = js,je + do I = Isq,Ieq + tmp = MAX (1.0 ,(G%mask2dT(i,j) + G%mask2dT(i+1,j) ) ) + ustar2_u(I,j)=(G%mask2dT(i,j)*ustar2_h(i,j)+G%mask2dT(i+1,j)*ustar2_h(i+1,j))/tmp + hbl_u(I,j) = (G%mask2dT(i,j)* hbl_h(i,j) + G%mask2dT(i+1,j)* hbl_h(i+1,j)) /tmp + taux_u(I,j) = forces%taux(I,j) / GV%H_to_RZ + enddo + enddo + do J = Jsq,Jeq + do i = is,ie + tmp = MAX ( 1.0 ,(G%mask2dT(i,j) + G%mask2dT(i,j+1) ) ) + ustar2_u(I,j)=(G%mask2dT(i,j)*ustar2_h(i,j)+G%mask2dT(i+1,j)*ustar2_h(i+1,j))/tmp + hbl_v(i,J) = (G%mask2dT(i,j)* hbl_h(i,J) + G%mask2dT(i,j+1)* hbl_h(i,j+1)) /tmp + if( j > jNseam-1 ) then + ustar2_v(i,J) = ustar2_h(i,j ) !w ( j > 456 ) j >= 457 + hbl_v(i,J) = hbl_h(i,j) + endif + tauy_v(i,J) = forces%tauy(i,J) / GV%H_to_RZ + enddo + enddo + call pass_vector(taux_u , tauy_v, G%Domain, To_All+Scalar_Pair) + if (CS%debug) then + call uvchksum("ustar2 ",ustar2_u, ustar2_v, G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum(" hbl ", hbl_u , hbl_v , G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum("surface tau[xy]_[uv] ", taux_u, tauy_v, G%HI, haloshift=0, scalar_pair=.true.) + endif +!W endif !w predictor step + +!w surface tauy_u , taux_v and omega_w2x_[u,v] & Implicit interface stresses tauxDG_u and tauyDG_v + tauy_u(:,:) = 0.0 + taux_v(:,:) = 0.0 + kbl_u(:,:) = 0 + kbl_v(:,:) = 0 + omega_w2x_u(:,:) = 0.0 + omega_w2x_v(:,:) = 0.0 + tauxDG_u(:,:,:) = 0.0 + tauyDG_v(:,:,:) = 0.0 + do j = js,je + do I = Isq,Ieq + if( (G%mask2dCu(I,j) > 0.5) ) then + tauy = 0.0 + tmp = MAX(1.0, (G%mask2dCv(i,j) + G%mask2dCv(i,j-1) + G%mask2dCv(i+1,j) + G%mask2dCv(i+1,j-1) ) ) + if ( G%mask2dCv(i ,j ) > 0.5 ) tauy = tauy + tauy_v(i ,j ) + if ( G%mask2dCv(i ,j-1) > 0.5 ) tauy = tauy + tauy_v(i ,j-1) + if ( G%mask2dCv(i+1,j ) > 0.5 ) tauy = tauy + tauy_v(i+1,j ) + if ( G%mask2dCv(i+1,j-1) > 0.5 ) tauy = tauy + tauy_v(i+1,j-1) + tauy = tauy / tmp + tauy_u(I,j) = (tauy/(abs(tauy)+GV%H_subroundoff)) * sqrt(MAX(GV%H_subroundoff,ustar2_u(I,j)*ustar2_u(I,j)-taux_u(I,j)*taux_u(I,j) )) + omega_w2x_u(I,j) = atan2( tauy_u(I,j) , taux_u(I,j) ) + tauxDG_u(I,j,1) = taux_u(I,j) !w ustar2_u(I,j) * cos(omega_w2x_u(I,j)) + depth = 0.0 + do k = 1, nz + depth = depth + CS%h_u(I,j,k) + if( (depth .ge. hbl_u(I,j)) .and. (kbl_u(I,j) .eq. 0 ) .and. (k > (kblmin-1)) ) then + kbl_u(I,j) = k + hbl_u(I,j) = depth + endif + enddo + endif + enddo + enddo + do J = Jsq,Jeq + do i = is,ie + if( (G%mask2dCv(i,J) > 0.5) ) then + taux = 0.0 + if ( j < 457 ) then + tmp = MAX(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i,j+1) + G%mask2dCu(i-1,j) + G%mask2dCu(i-1,j+1) ) ) + if ( G%mask2dCu(i ,j ) > 0.5 ) taux = taux + taux_u(i ,j ) + if ( G%mask2dCu(i ,j+1) > 0.5 ) taux = taux + taux_u(i ,j+1) + if ( G%mask2dCu(i-1,j ) > 0.5 ) taux = taux + taux_u(i-1,j ) + if ( G%mask2dCu(i-1,j+1) > 0.5 ) taux = taux + taux_u(i-1,j+1) + else + tmp = MAX(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i-1,j) ) ) + if ( G%mask2dCu(i ,j ) > 0.5 ) taux = taux + taux_u(i ,j ) + if ( G%mask2dCu(i-1,j ) > 0.5 ) taux = taux + taux_u(i-1,j ) + endif + taux = taux / tmp + taux_v(i,J) = (taux/(abs(taux)+GV%H_subroundoff)) * sqrt(MAX(GV%H_subroundoff,ustar2_v(i,J)*ustar2_v(i,J)-tauy_v(i,J)*tauy_v(i,J) )) + omega_w2x_v(i,J) = atan2( tauy_v(i,J) , taux_v(i,J) ) + tauyDG_v(i,J,1) = tauy_v(i,J) !w ustar2_v(i,J) * cos(omega_w2x_v(i,J)) + depth = 0.0 + do k = 1, nz + depth = depth + CS%h_v(i,J,k) + if( (depth .ge. hbl_v(i,J)) .and. (kbl_v(i,J) .eq. 0 ) .and. (k > (kblmin-1)) ) then + kbl_v(i,J) = k + hbl_v(i,J) = depth + endif + enddo + endif + enddo + enddo +endif !w predictor step + +! Thickness weighted diagnostic interpolations ! Copy Implicit [uv]i to [uv]old + call pass_vector(ui,vi, G%Domain, To_All+Scalar_Pair) + vi_u(:,:,:) = 0. + ui_v(:,:,:) = 0. + tauxDG_u(:,:,:) = 0.0 + tauyDG_v(:,:,:) = 0.0 + tauxDG_v(:,:,:) = 0. + tauyDG_u(:,:,:) = 0. + do k = 1, nz + kp = MIN( k+1 , nz) + do j = js-1 ,je+1 + do I = Isq-1, Ieq+1 + tauxDG_u(I,j,k+1) = CS%a_u(I,j,kp) * (ui(I,j,k) - ui(I,j,kp)) + enddo + enddo + do J = Jsq-1, Jeq+1 + do i = is-1, ie+1 + tauyDG_v(i,J,k+1) = CS%a_v(i,J,kp) * (vi(i,J,k) - vi(i,J,kp)) + enddo + enddo + + ! v to u points + do j = js , je + do I = Isq, Ieq + vi_u(I,j,k) = set_v_at_u(vi, h, G, GV, I, j, k, G%mask2dCv, OBC) + tauyDG_u(I,j,k)= set_v_at_u(tauyDG_v, h, G, GV, I, j, k, G%mask2dCv, OBC) + enddo + enddo + ! u to v points + do J = Jsq, Jeq + do i = is, ie + ui_v(I,j,k) = set_u_at_v(ui, h, G, GV, i, J, k, G%mask2dCu, OBC) + tauxDG_v(i,J,k)= set_u_at_v(tauxDG_u, h, G, GV, i, J, k, G%mask2dCu, OBC) + enddo + enddo + enddo + if (CS%debug) then + call uvchksum(" vi_u ui_v ", vi_u , ui_v , G%HI, haloshift=0, scalar_pair=.true.) + endif + +! compute angles, tau2x_[u,v], tau2w_[u,v], tau2s_[u,v], s2x_[u,v], s2w_[u,v] and stress mag tau_[u,v] + omega_tau2x_u(:,:,:) = 0.0 + omega_tau2x_v(:,:,:) = 0.0 + omega_tau2w_u(:,:,:) = 0.0 + omega_tau2w_v(:,:,:) = 0.0 + omega_tau2s_u(:,:,:) = 0.0 + omega_tau2s_v(:,:,:) = 0.0 + omega_s2x_u(:,:,:) = 0.0 + omega_s2x_v(:,:,:) = 0.0 + omega_s2w_u(:,:,:) = 0. + omega_s2w_v(:,:,:) = 0. + tau_u(:,:,:) = 0.0 + tau_v(:,:,:) = 0.0 + +!w Default implicit (I) stress magnitude tau_[uv] & direction Omega_tau2(w,s,x)_[uv] Profiles + do j = js,je + do I = Isq,Ieq + if( (G%mask2dCu(I,j) > 0.5) ) then + tauyDG_u(I,j,1) = tauy_u(I,j) ! SURFACE + tau_u(I,j,1) = ustar2_u(I,j) !w stress magnitude + Omega_tau2w_u(I,j,1) = 0.0 + Omega_tau2x_u(I,j,1) = omega_w2x_u(I,j) + Omega_tau2s_u(I,j,1) = 0.0 + omega_s2x_u(I,j,1) = omega_w2x_u(I,j) + omega_s2w_u(I,j,1) = 0.0 + + do k=1,nz + kp1 = MIN(k+1 , nz) + tau_u(I,j,k+1) = sqrt( tauxDG_u(I,j,k+1)*tauxDG_u(I,j,k+1) + tauyDG_u(I,j,k+1)*tauyDG_u(I,j,k+1)) + Omega_tau2x_u(I,j,k+1) = atan2( tauyDG_u(I,j,k+1) , tauxDG_u(I,j,k+1) ) + + du = ui(i,J,k) - ui(i,J,kp1) + dv = vi_u(i,J,k) - vi_u(i,J,kp1) + omega_s2x_u(I,j,k+1) = atan2( dv , du) !w ~ Omega_tau2x + + omega_tmp = Omega_tau2x_u(I,j,k+1) - omega_w2x_u(I,j) + if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi + if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi + Omega_tau2w_u(I,j,k+1) = omega_tmp + + omega_tmp = Omega_tau2x_u(I,j,k+1) - omega_s2x_u(I,j,k+1) + if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi + if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi + Omega_tau2s_u(I,j,k+1) = omega_tmp !w ~ 0 + + omega_tmp = omega_s2x_u(I,j,k+1) - omega_w2x_u(I,j) + if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi + if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi + omega_s2w_u(I,j,k+1) = omega_tmp !w ~ Omega_tau2w + + enddo + endif + enddo + enddo + do J = Jsq, Jeq + do i = is, ie + if( (G%mask2dCv(i,J) > 0.5) ) then + tauxDG_v(i,J,1) = taux_v(i,J) ! SURFACE + tau_v(i,J,1) = ustar2_v(i,J) + Omega_tau2w_v(i,J,1) = 0.0 + Omega_tau2x_v(i,J,1) = omega_w2x_v(i,J) + Omega_tau2s_v(i,J,1) = 0.0 + omega_s2x_v(i,J,1) = omega_w2x_v(i,J) + omega_s2w_v(i,J,1) = 0.0 + + do k=1,nz-1 + kp1 = MIN(k+1 , nz) + tau_v(i,J,k+1) = sqrt ( tauxDG_v(i,J,k+1)*tauxDG_v(i,J,k+1) + tauyDG_v(i,J,k+1)*tauyDG_v(i,J,k+1) ) + Omega_tau2x_v(i,J,k+1) = atan2( tauyDG_v(i,J,k+1) , tauxDG_v(i,J,k+1) ) + + du = ui_v(i,J,k) - ui_v(i,J,kp1) + dv = vi(i,J,k) - vi(i,J,kp1) + omega_s2x_v(i,J,k+1) = atan2( dv , du ) !~ Omega_tau2x + + omega_tmp = Omega_tau2x_v(i,J,k+1) - omega_w2x_v(i,J) + if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi + if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi + Omega_tau2w_v(i,J,k+1) = omega_tmp + + omega_tmp = Omega_tau2x_v(i,J,k+1) - omega_s2x_v(i,J,k+1) + if (omega_tmp .gt. pi ) omega_tmp = omega_tmp - 2.*pi + if (omega_tmp .le. (0.-pi) ) omega_tmp = omega_tmp + 2.*pi + Omega_tau2s_v(i,J,k+1) = omega_tmp !w ~ 0 + + omega_tmp = omega_s2x_v(i,J,k+1) - omega_w2x_v(i,J) + if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi + if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi + omega_s2w_v(i,J,k+1) = omega_tmp !w ~ Omega_tau2w + + enddo + endif + enddo + enddo +! ********************************************************************************************** +!w Parameterized stress orientation from the wind at interfaces (tau2x) and centers (tau2x) OVERWRITE to kbl-interface above hbl + du_rot(:,:,:) = 0.0 + dv_rot(:,:,:) = 0.0 + mask3d_u(:,:,:) = 0.0 + mask3d_v(:,:,:) = 0.0 + do j = js,je !w U-points + do I = Isq,Ieq + if( (G%mask2dCu(I,j) > 0.5) ) then + kbld = MIN( (kbl_u(I,j)) , (nz-2) ) + if ( tau_u(I,j,kbld+2) > tau_u(I,j,kbld+1) ) kbld = kbld + 1 + !w if ( tau_u(I,j,kbld+2) > tau_u(I,j,kbld+1) ) kbld = kbld + 1 + + tauh = tau_u(I,j,kbld+1) + GV%H_subroundoff + omega_tau2wh = omega_tau2w_u(I,j,kbld+1) + + depth = 0. ! surface boundary conditions + tauNLup = 0.0 + do k=1, kbld + depth = depth + CS%h_u(I,j,k) + if ( (L19 > 0) ) then + sigma = MIN ( 1.0 , depth / hbl_u(i,j) ) + G_sig = MIN ( 0.287 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (1.74392*sigma - 2.58538) ) ) + + tau_MAG = (ustar2_u(I,j) * (1.-sigma) ) + (tauh * sigma ) !w linear stress mag + omega_s2x = Omega_tau2x_u(I,j,k+1) + cos_tmp = tauxDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff) + sin_tmp = tauyDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff) + Wind_x = ustar2_u(I,j) * cos(omega_w2x_u(I,j)) !w taux_u primary + Wind_y = ustar2_u(I,j) * sin(omega_w2x_u(I,j)) !w tauy_u interpolated + tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) !wind in x' + tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) !WCG in y' + omega_w2s = atan2( tauNL_CG , tauNL_DG ) !W wind to shear x' (limiter) + omega_s2w = 0.0-omega_w2s + tauNL_CG = Cemp_CG * G_sig * tauNL_CG +!OPTIONS + if(L19 .eq. 1) then !A L19=1 + tau_MAG = MAX( tau_MAG , tauNL_CG ) + tauNL_DG = sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - tau_u(I,j,k+1) + endif + + if(L19 .eq. 2) then !B L19=2 + tauNL_CG = MIN( tauNL_CG , tau_MAG ) + tauNL_DG = sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - tau_u(I,j,k+1) + endif + + if(L19 .eq. 3) then !C L19=3 + tauNL_DG = tau_MAG - tau_u(I,j,k+1) + tau_MAG = sqrt( tau_MAG*tau_MAG + tauNL_CG*tauNL_CG ) + endif + omega_tmp = atan2( tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG) ) !W Limiters + + tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) !w back to x,y coordinates + tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) + tauNLdn = tauNL_X ! SOLUTION + du_rot(I,j,k) = (tauNLup - tauNLdn) * (dt/CS%h_u(I,j,k) + GV%H_subroundoff) + tauNLup = tauNLdn + + mask3d_u(I,j,k) = tauNL_CG / (tau_MAG) !W (tauNLup - tauNLdn) + mask3d_v(i,j,k) = (tau_u(I,j,k+1)+tauNL_DG) / (tau_MAG) + ! DIAGNOSTICS + tau_u(I,j,k+1) = sqrt( (tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2 ) + omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y) , (tauxDG_u(I,j,k+1) + tauNL_X) ) + + omega_tau2w = omega_tau2x - omega_w2x_u(I,j) + if (omega_tau2w .gt. pi ) omega_tau2w = omega_tau2w - 2.*pi + if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi + Omega_tau2w_u(I,j,k+1) = omega_tau2w + Omega_tau2s_u(I,j,k+1) = omega_tmp !W omega_tau2x - Omega_tau2x_u(I,j,k+1) + Omega_tau2x_u(I,j,k+1) = 0.0 - omega_w2s !W omega_s2x !W 0.0 - omega_w2s !W omega_tau2x + + endif + enddo + endif + enddo + enddo +!w V-point dv increment %%%%%%%%%%%%%%%%%%%%%%%%%%%% + do J = Jsq,Jeq + do i = is,ie + if( (G%mask2dCv(i,J) > 0.5) ) then + kbld = MIN( (kbl_v(i,J)) , (nz-2) ) + if ( tau_v(i,J,kbld+2) > tau_v(i,J,kbld+1) ) kbld = kbld + 1 + tauh = tau_v(i,J,kbld+1) + omega_tau2wh = omega_tau2w_u(I,j,kbld+1) + + depth = 0. !surface boundary conditions + tauNLup = 0.0 + do k=1, kbld + depth = depth + CS%h_v(i,J,k) + if ( (L19 > 0) ) then + sigma = MIN ( 1.0 , (depth ) / hbl_v(I,J) ) + G_sig = MIN ( 0.287 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (1.74392*sigma - 2.58538) ) ) + + tau_MAG = (ustar2_v(i,J) * (1.-sigma) ) + (tauh * sigma ) !w linear stress + omega_s2x = Omega_tau2x_v(i,J,k+1) + cos_tmp = tauxDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) + sin_tmp = tauyDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) + Wind_x = ustar2_v(i,J) * cos(omega_w2x_v(i,J)) !w taux_v interpolated + Wind_y = ustar2_v(i,J) * sin(omega_w2x_v(i,J)) !w tauy_v primary + tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) + tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) !w WCG + omega_w2s = atan2( tauNL_CG , tauNL_DG ) ! tau2x' limiter + omega_s2w = 0.0 - omega_w2s + tauNL_CG = Cemp_CG * G_sig * tauNL_CG +!OPTIONS + if(L19 .eq. 1) then !A L19=1 + tau_MAG = MAX( tau_MAG , tauNL_CG ) + tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) + endif + + if(L19 .eq. 2) then !B L19=2 + tauNL_CG = MIN( tauNL_CG , tau_MAG ) + tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) + endif + + if(L19 .eq. 3) then !C L19=3 + tauNL_DG = 0.0 - tau_v(i,J,k+1) + tau_MAG + tau_MAG = sqrt( tau_MAG*tau_MAG + tauNL_CG*tauNL_CG ) + endif + + omega_tmp = atan2( tauNL_CG , tau_v(i,J,k+1) + tauNL_DG ) !W LIMITERS as (tauNL_CG / tau_MAG) + + tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) ! back to x,y coordinate + tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) + tauNLdn = tauNL_Y + dv_rot(i,J,k) = (tauNLup - tauNLdn) * (dt/(CS%h_v(i,J,k)) ) ! SOLUTION + tauNLup = tauNLdn + ! DIAGNOSTICS + tau_v(i,J,k+1) = sqrt( (tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2 ) + omega_tau2x = atan2( (tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X) ) + omega_tau2w = omega_tau2x - omega_w2x_v(i,J) + if (omega_tau2w .gt. pi ) omega_tau2w = omega_tau2w - 2.*pi + if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi + + Omega_tau2w_v(i,J,k+1) = omega_tau2w + Omega_tau2s_v(i,J,k+1) = omega_tmp !W omega_tau2x - Omega_tau2x_v(i,J,k+1) + Omega_tau2x_v(i,J,k+1) = 0.0 - omega_w2s !W omega_s2x !W 0.0 - omega_w2s !W omega_tau2x + endif + enddo + endif + enddo + enddo + if (CS%debug) then + call uvchksum("FP-tau_[uv] ", tau_u, tau_v, G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum("FP-omega_s2x ",omega_s2x_u,omega_s2x_v,G%HI,haloshift=0,scalar_pair=.true.) + call uvchksum("FP-omega_s2w ",omega_s2w_u,omega_s2w_v,G%HI,haloshift=0,scalar_pair=.true.) + call uvchksum("FP-omega_t2w ",omega_tau2x_u,omega_tau2x_v,G%HI,haloshift=0,scalar_pair=.true.) + call uvchksum("FP-omega_t2x ",omega_tau2x_u ,omega_tau2x_v ,G%HI,haloshift=0,scalar_pair=.true.) + call uvchksum("FP-d[uv]_rot ",du_rot, dv_rot, G%HI, haloshift=0,scalar_pair=.true.) + call uvchksum("FP-d[uv]_out ",uold , vold , G%HI, haloshift=0,scalar_pair=.true.) + endif + +!w OUTPUT + do k=1,nz + do j = js,je + do I = Isq,Ieq + ui(I,j,k) = uold(I,j,k) + du_rot(I,j,k) + uold(I,j,k) = du_rot(I,j,k) + enddo + enddo + do J = Jsq,Jeq + do i = is,ie + vi(i,J,k) = vold(i,J,k) + dv_rot(i,J,k) + vold(i,J,k) = dv_rot(i,J,k) + enddo + enddo + enddo + +if( LU_pred .eq. .false. ) then !W CONDITION DIAGNOSTIC OUTPUT THEN POST + do j = js,je + do I = Isq,Ieq + if( (G%mask2dCu(I,j) > 0.5) ) then + kbld = kbl_u(I,j) + ustar2 = ustar2_u(I,j) + tau_u(I,j,1) = tau_u(I,j,1) / ustar2 + Omega_tau2w_u(I,j,1) = Omega_tau2w_u(I,j,1) / pi + Omega_tau2x_u(I,j,1) = Omega_tau2x_u(I,j,1) / pi + Omega_tau2s_u(I,j,1) = Omega_tau2s_u(I,j,1) / pi + do k=1,nz + !w mask3d_u(I,j,k) = + tau_u(I,j,k+1) = tau_u(I,j,k+1) / ustar2 + Omega_tau2w_u(I,j,k+1) = Omega_tau2w_u(I,j,k+1) /pi + Omega_tau2x_u(I,j,k+1) = Omega_tau2x_u(I,j,k+1) /pi + Omega_tau2s_u(I,j,k+1) = Omega_tau2s_u(I,j,k+1) /pi + if( k .eq. kbld+2) then + tau_u(I,j,k) = 0.0 - tau_u(I,j,k) + Omega_tau2w_u(I,j,k) = 1.05 + Omega_tau2x_u(I,j,k) = 1.05 + Omega_tau2s_u(I,j,k) = 1.05 + endif + enddo + Omega_tau2x_u(I,j,nz+1) = omega_w2x_u(I,j) / pi + mask3d_u(I,j,nz) = ustar2_u(I,j) + mask3d_u(I,j,nz-1) = sqrt(taux_u(I,j)*taux_u(I,j) + tauy_u(I,j)*tauy_u(I,j) ) + endif + enddo + enddo + do J = Jsq,Jeq !w v-points + do i = is,ie + if( (G%mask2dCv(i,J) > 0.5) ) then + kbld = kbl_v(i,J) + ustar2 = ustar2_v(i,J) + tau_v(i,J,1) = tau_v(i,J,1) / ustar2 + Omega_tau2w_v(i,J,1) = Omega_tau2w_v(i,J,1) / pi + Omega_tau2x_v(i,J,1) = Omega_tau2x_v(i,J,1) / pi + Omega_tau2s_v(i,J,1) = Omega_tau2s_v(i,J,1) / pi + do k=1,nz + !w mask3d_v(i,J,k) = tauxDG_v(i,J,k) !w vi(i,J,k) - v(i,J,k) !w dv_rot(i,J,k) + tau_v(i,J,k+1) = tau_v(i,J,k+1) / ustar2 + Omega_tau2w_v(i,J,k+1) = Omega_tau2w_v(i,J,k+1) /pi + Omega_tau2x_v(i,J,k+1) = Omega_tau2x_v(i,J,k+1) /pi + Omega_tau2s_v(i,J,k+1) = Omega_tau2s_v(i,J,k+1) /pi + if( k .eq. kbld+2) then + tau_v(i,J,k) = 0.0 - tau_v(i,J,k) + Omega_tau2w_v(i,J,k) = 1.05 + Omega_tau2x_v(i,J,k) = 1.05 + Omega_tau2s_v(i,J,k) = 1.05 + endif + enddo + Omega_tau2x_v(i,J,nz+1) = omega_w2x_v(i,J) / pi + mask3d_v(i,J,nz) = ustar2_v(i,J) + mask3d_v(i,J,nz-1) = sqrt(taux_v(i,J)*taux_v(i,J) + tauy_v(i,J)*tauy_v(i,J) ) + endif + enddo + enddo + + if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) + if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) + if (CS%id_FPtau2s_u > 0) call post_data(CS%id_FPtau2s_u, omega_tau2s_u, CS%diag) + if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag) + if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag) + if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag) + if (CS%id_FPtau2x_u > 0) call post_data(CS%id_FPtau2x_u, omega_tau2x_u, CS%diag) + if (CS%id_FPtau2x_v > 0) call post_data(CS%id_FPtau2x_v, omega_tau2x_v, CS%diag) + if (CS%id_FPmask_u > 0) call post_data(CS%id_FPmask_u, mask3d_u, CS%diag) + if (CS%id_FPmask_v > 0) call post_data(CS%id_FPmask_v, mask3d_v, CS%diag) + if (CS%id_FPhbl_u > 0) call post_data(CS%id_FPhbl_u, hbl_u, CS%diag) + if (CS%id_FPhbl_v > 0) call post_data(CS%id_FPhbl_v, hbl_v, CS%diag) + + if (cs%debug) then + call uvchksum("post viscFPmix [ui,vi]",ui,vi,G%HI,haloshift=0,scalar_pair=.true.) + endif +endif ! LU_pred = false + +end subroutine vertFPmix + !> Perform a fully implicit vertical diffusion !! of momentum. Stress top and bottom boundary conditions are used. !! @@ -1828,6 +2406,38 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', & thickness_units, conversion=GV%H_to_MKS) + !w FPmix + CS%id_FPhbl_u = register_diag_field('ocean_model', 'FPhbl_u', diag%axesCu1, Time, & + 'Boundary-Layer Depth (u-points)','m') !w , conversion=GV%H_to_MKS) + CS%id_FPhbl_v = register_diag_field('ocean_model', 'FPhbl_v', diag%axesCv1, Time, & + 'Boundary-Layer Depth (v-points)','m') + + CS%id_FPmask_u = register_diag_field('ocean_model', 'FPmask_u', diag%axesCuL, Time, & + 'FP overwrite mask (u-points)','binary') + CS%id_FPmask_v = register_diag_field('ocean_model', 'FPmask_v', diag%axesCvL, Time, & + 'FP overwrite mask (v-points)','binary') + + CS%id_tauFP_u = register_diag_field('ocean_model', 'tauFP_u', diag%axesCui, Time, & + 'Stress Mag Profile (u-points)', 'm2 s-2') !w , conversion=GV%H_to_MKS) + CS%id_tauFP_v = register_diag_field('ocean_model', 'tauFP_v', diag%axesCvi, Time, & + 'Stress Mag Profile (v-points)', 'm2 s-2') !w , conversion=GV%H_to_MKS) + + CS%id_FPtau2s_u = register_diag_field('ocean_model', 'FPtau2s_u', diag%axesCui, Time, & + 'stress from shear direction (u-points)', 'pi ') + CS%id_FPtau2s_v = register_diag_field('ocean_model', 'FPtau2s_v', diag%axesCvi, Time, & + 'stress from shear direction (v-points)', 'pi ') + + CS%id_FPtau2w_u = register_diag_field('ocean_model', 'FPtau2w_u', diag%axesCui, Time, & + 'stress from wind direction (u-points)', 'pi ') + CS%id_FPtau2w_v = register_diag_field('ocean_model', 'FPtau2w_v', diag%axesCvi, Time, & + 'stress from wind direction (v-points)', 'pi ') + + CS%id_FPtau2x_u = register_diag_field('ocean_model', 'FPs2w_u', diag%axesCui, Time, & + 'shear from wind (u-points)', 'pi ') + CS%id_FPtau2x_v = register_diag_field('ocean_model', 'FPs2w_v', diag%axesCvi, Time, & + 'shear from wind (v-points)', 'pi ' + ! w - end + CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, Time, & 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) From cb65bdcefd1a51acea19767b5e12502798aba7ec Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 May 2022 14:33:09 -0600 Subject: [PATCH 003/213] Change name of logical Replaces LU_pred to L_diag, since now this logical only controls if diagnostics should be posted. --- src/core/MOM_dynamics_split_RK2.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 8c3612f50b..f6cf456f98 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -362,7 +362,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. - logical :: LU_pred ! Controls if it is predictor step or not + logical :: L_diag ! Controls if diagostics are posted in the vertFPmix logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -666,12 +666,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (CS%fpmix) then - LU_pred = .true. + L_diag = .false. hbl(:,:) = 0.0 if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) if (ASSOCIATED(CS%energetic_PBL_CSp)) & call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, m_to_MLD_units=GV%m_to_H) - call vertFPmix(LU_pred, up, vp, uold, vold, hbl, h, forces, & + call vertFPmix(L_diag, up, vp, uold, vold, hbl, h, forces, & dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -914,8 +914,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (CS%fpmix) then - LU_pred = .false. - call vertFPmix(LU_pred, u, v, uold, vold, hbl, h, forces, dt, & + L_diag = .true. + call vertFPmix(L_diag, u, v, uold, vold, hbl, h, forces, dt, & G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) From 143d117527746736707c49444ad554cf3f3901d6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 May 2022 15:22:07 -0600 Subject: [PATCH 004/213] Updates to vertFPmix This commit adds the latest updates to the vertFPmix subroutine after Bill Large did some cleaning. We have highlight places in the code where work must be done. --- .../vertical/MOM_vert_friction.F90 | 648 ++++++------------ 1 file changed, 227 insertions(+), 421 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d5a7aa9804..1d4f7bf646 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -128,8 +128,8 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 - integer :: id_FPmask_u = -1, id_FPmask_v = -1 , id_FPhbl_u = -1, id_FPhbl_v = -1 - integer :: id_tauFP_u = -1, id_tauFP_v = -1 , id_FPtau2x_u = -1, id_FPtau2x_v = -1 + integer :: id_FPdiag_u = -1, id_FPdiag_v = -1 , id_FPw2x = -1 !W id_FPhbl_u = -1, id_FPhbl_v = -1 + integer :: id_tauFP_u = -1, id_tauFP_v = -1 !W, id_FPtau2x_u = -1, id_FPtau2x_v = -1 integer :: id_FPtau2s_u = -1, id_FPtau2s_v = -1, id_FPtau2w_u = -1, id_FPtau2w_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 @@ -147,9 +147,8 @@ module MOM_vert_friction contains -!> Add nonlocal momentum flux profile increments -!! TODO: add more description -subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OBC) ! FPmix +!> Add nonlocal stress increments to u^n (uold) and v^n (vold) using ui and vi. +subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -164,123 +163,77 @@ subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, U real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: hbl_h ! boundary layer depth - logical, intent(inout) :: LU_pred !w predictor step or NOT - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [T ~> s] - type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure - type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + logical, intent(in) :: L_diag !< controls if diagnostics should be posted + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure + type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: mask3d_u !Test Plots @ 3-D centers - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: mask3d_v - real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u !2-D + ! WGL; TODO: add description to local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: FPdiag_u !< this is for ... + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: FPdiag_v + real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u real, dimension(SZI_(G),SZJB_(G)) :: hbl_v integer, dimension(SZIB_(G),SZJ_(G)) :: kbl_u integer, dimension(SZI_(G),SZJB_(G)) :: kbl_v - real, dimension(SZI_(G),SZJ_(G)) :: ustar2_h !2-D surface real, dimension(SZIB_(G),SZJ_(G)) :: ustar2_u real, dimension(SZI_(G),SZJB_(G)) :: ustar2_v real, dimension(SZIB_(G),SZJ_(G)) :: taux_u real, dimension(SZI_(G),SZJB_(G)) :: tauy_v - real, dimension(SZIB_(G),SZJ_(G)) :: tauy_u - real, dimension(SZI_(G),SZJB_(G)) :: taux_v - real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u - real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v + real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u + real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tau_u !3-D interfaces + ! GMM; TODO: make arrays allocatable if possible + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tau_u real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tau_v real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauxDG_u real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauyDG_u real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauxDG_v real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauyDG_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2x_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2x_v real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2s_u real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2s_v real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2w_u real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2w_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_s2x_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_s2x_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_s2w_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_s2w_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: du_rot !3-D centers - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: dv_rot - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: vi_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: ui_v - - real :: tauxDG, tauyDG, tauxDGup, tauyDGup, ustar2, MAXinc, MINthick - real :: du, dv, du_v, dv_u , dup, dvp , uZero, vZero - real :: fEQband, Cemp_SS , Cemp_LS , Cemp_CG, Cemp_DG , Wgt_SS + + real :: pi, Cemp_CG, tmp, cos_tmp, sin_tmp, omega_tmp + real :: du, dv, depth, sigma, Wind_x, Wind_y + real :: taux, tauy, tauxDG, tauyDG, tauxDGup, tauyDGup, ustar2, tauh real :: tauNLup, tauNLdn, tauNL_CG, tauNL_DG, tauNL_X, tauNL_Y, tau_MAG - real :: pi, tmp, cos_tmp, sin_tmp, depth, taux, tauy, tauk, tauxI , tauyI, sign_f - real :: tauxh, tauyh, tauh, omega_s2xh, omega_s2wh, omega_tau2xh, omega_tau2wh - real :: taux0, tauy0, tau0, sigma, G_sig, Wind_x, Wind_y, omega_w2s, omega_tau2s,omega_s2x - real :: omega_tau2x, omega_tau2w, omega_SS, omega_LS, omega_tmp, omega_s2xI, omega_s2w - integer :: kblmin, kbld, kp, km, kp1, L19 ,jNseam + real :: omega_w2s, omega_tau2s, omega_s2x, omega_tau2x, omega_tau2w, omega_s2w + integer :: kblmin, kbld, kp1 integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec; js = G%jsc; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke pi = 4. * atan2(1.,1.) - L19 = 1 !w Options A = 1, B = 2, C = 3 - Cemp_CG = 3.6 !w L91 cross-gradient - Cemp_DG = 1.0 !w L91 down-gradient - MAXinc = -1.0 !w if positive - MINthick= 0.01 !w GV%H_subroundoff !w 0.5 + Cemp_CG = 3.6 kblmin = 1 - jNseam = 457 !w north seam = SZJ_(G) + FPdiag_u(:,:,:) = 0.0 + FPdiag_v(:,:,:) = 0.0 + taux_u(:,:) = 0. + tauy_v(:,:) = 0. -if(LU_pred ) then !w predictor step only, surface forcing - ustar2_h(:,:) = 0. - do j = js,je !w ?GMM -1,+1 with forces% - do i = is,ie - ustar2_h(i,j) = forces%ustar(i,j) * forces%ustar(i,j) - !w omega_w2x_h(i,j) = forces%omega_w2x(i,j) - enddo - enddo - call pass_var(ustar2_h ,G%Domain) ! update halos ?GMM - call pass_var( hbl_h ,G%Domain) - -! SURFACE ustar2 and x-stress to u points and ustar2 and y-stress to v points - ustar2_u(:,:) = 0. - ustar2_v(:,:) = 0. - hbl_u(:,:) = 0. - hbl_v(:,:) = 0. - taux_u(:,:) = 0. - tauy_v(:,:) = 0. do j = js,je do I = Isq,Ieq - tmp = MAX (1.0 ,(G%mask2dT(i,j) + G%mask2dT(i+1,j) ) ) - ustar2_u(I,j)=(G%mask2dT(i,j)*ustar2_h(i,j)+G%mask2dT(i+1,j)*ustar2_h(i+1,j))/tmp - hbl_u(I,j) = (G%mask2dT(i,j)* hbl_h(i,j) + G%mask2dT(i+1,j)* hbl_h(i+1,j)) /tmp - taux_u(I,j) = forces%taux(I,j) / GV%H_to_RZ + taux_u(I,j) = forces%taux(I,j) / GV%H_to_RZ !W rho0=1035. enddo enddo + do J = Jsq,Jeq do i = is,ie - tmp = MAX ( 1.0 ,(G%mask2dT(i,j) + G%mask2dT(i,j+1) ) ) - ustar2_u(I,j)=(G%mask2dT(i,j)*ustar2_h(i,j)+G%mask2dT(i+1,j)*ustar2_h(i+1,j))/tmp - hbl_v(i,J) = (G%mask2dT(i,j)* hbl_h(i,J) + G%mask2dT(i,j+1)* hbl_h(i,j+1)) /tmp - if( j > jNseam-1 ) then - ustar2_v(i,J) = ustar2_h(i,j ) !w ( j > 456 ) j >= 457 - hbl_v(i,J) = hbl_h(i,j) - endif - tauy_v(i,J) = forces%tauy(i,J) / GV%H_to_RZ + tauy_v(i,J) = forces%tauy(i,J) / GV%H_to_RZ enddo enddo - call pass_vector(taux_u , tauy_v, G%Domain, To_All+Scalar_Pair) - if (CS%debug) then - call uvchksum("ustar2 ",ustar2_u, ustar2_v, G%HI, haloshift=0, scalar_pair=.true.) - call uvchksum(" hbl ", hbl_u , hbl_v , G%HI, haloshift=0, scalar_pair=.true.) - call uvchksum("surface tau[xy]_[uv] ", taux_u, tauy_v, G%HI, haloshift=0, scalar_pair=.true.) - endif -!W endif !w predictor step -!w surface tauy_u , taux_v and omega_w2x_[u,v] & Implicit interface stresses tauxDG_u and tauyDG_v - tauy_u(:,:) = 0.0 - taux_v(:,:) = 0.0 - kbl_u(:,:) = 0 - kbl_v(:,:) = 0 + call pass_var( hbl_h ,G%Domain, halo=1 ) + call pass_vector(taux_u , tauy_v, G%Domain, To_All ) + ustar2_u(:,:) = 0. + ustar2_v(:,:) = 0. + hbl_u(:,:) = 0. + hbl_v(:,:) = 0. + kbl_u(:,:) = 0 + kbl_v(:,:) = 0 omega_w2x_u(:,:) = 0.0 omega_w2x_v(:,:) = 0.0 tauxDG_u(:,:,:) = 0.0 @@ -288,16 +241,14 @@ subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, U do j = js,je do I = Isq,Ieq if( (G%mask2dCu(I,j) > 0.5) ) then - tauy = 0.0 - tmp = MAX(1.0, (G%mask2dCv(i,j) + G%mask2dCv(i,j-1) + G%mask2dCv(i+1,j) + G%mask2dCv(i+1,j-1) ) ) - if ( G%mask2dCv(i ,j ) > 0.5 ) tauy = tauy + tauy_v(i ,j ) - if ( G%mask2dCv(i ,j-1) > 0.5 ) tauy = tauy + tauy_v(i ,j-1) - if ( G%mask2dCv(i+1,j ) > 0.5 ) tauy = tauy + tauy_v(i+1,j ) - if ( G%mask2dCv(i+1,j-1) > 0.5 ) tauy = tauy + tauy_v(i+1,j-1) - tauy = tauy / tmp - tauy_u(I,j) = (tauy/(abs(tauy)+GV%H_subroundoff)) * sqrt(MAX(GV%H_subroundoff,ustar2_u(I,j)*ustar2_u(I,j)-taux_u(I,j)*taux_u(I,j) )) - omega_w2x_u(I,j) = atan2( tauy_u(I,j) , taux_u(I,j) ) - tauxDG_u(I,j,1) = taux_u(I,j) !w ustar2_u(I,j) * cos(omega_w2x_u(I,j)) + tmp = MAX (1.0 ,(G%mask2dT(i,j) + G%mask2dT(i+1,j) ) ) + hbl_u(I,j) = (G%mask2dT(i,j)* hbl_h(i,j) + G%mask2dT(i+1,j) * hbl_h(i+1,j)) /tmp + tmp = MAX(1.0, (G%mask2dCv(i,j) + G%mask2dCv(i,j-1) + G%mask2dCv(i+1,j) + G%mask2dCv(i+1,j-1) ) ) + tauy = ( G%mask2dCv(i ,j )*tauy_v(i ,j ) + G%mask2dCv(i ,j-1)*tauy_v(i ,j-1) & + + G%mask2dCv(i+1,j )*tauy_v(i+1,j ) + G%mask2dCv(i+1,j-1)*tauy_v(i+1,j-1) ) / tmp + ustar2_u(I,j) = sqrt( taux_u(I,j)*taux_u(I,j) + tauy*tauy ) + omega_w2x_u(I,j) = atan2( tauy , taux_u(I,j) ) + tauxDG_u(I,j,1) = taux_u(I,j) depth = 0.0 do k = 1, nz depth = depth + CS%h_u(I,j,k) @@ -312,22 +263,14 @@ subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, U do J = Jsq,Jeq do i = is,ie if( (G%mask2dCv(i,J) > 0.5) ) then - taux = 0.0 - if ( j < 457 ) then - tmp = MAX(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i,j+1) + G%mask2dCu(i-1,j) + G%mask2dCu(i-1,j+1) ) ) - if ( G%mask2dCu(i ,j ) > 0.5 ) taux = taux + taux_u(i ,j ) - if ( G%mask2dCu(i ,j+1) > 0.5 ) taux = taux + taux_u(i ,j+1) - if ( G%mask2dCu(i-1,j ) > 0.5 ) taux = taux + taux_u(i-1,j ) - if ( G%mask2dCu(i-1,j+1) > 0.5 ) taux = taux + taux_u(i-1,j+1) - else - tmp = MAX(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i-1,j) ) ) - if ( G%mask2dCu(i ,j ) > 0.5 ) taux = taux + taux_u(i ,j ) - if ( G%mask2dCu(i-1,j ) > 0.5 ) taux = taux + taux_u(i-1,j ) - endif - taux = taux / tmp - taux_v(i,J) = (taux/(abs(taux)+GV%H_subroundoff)) * sqrt(MAX(GV%H_subroundoff,ustar2_v(i,J)*ustar2_v(i,J)-tauy_v(i,J)*tauy_v(i,J) )) - omega_w2x_v(i,J) = atan2( tauy_v(i,J) , taux_v(i,J) ) - tauyDG_v(i,J,1) = tauy_v(i,J) !w ustar2_v(i,J) * cos(omega_w2x_v(i,J)) + tmp = MAX ( 1.0 ,(G%mask2dT(i,j) + G%mask2dT(i,j+1) ) ) + hbl_v(i,J) = (G%mask2dT(i,j)* hbl_h(i,J) + G%mask2dT(i,j+1) * hbl_h(i,j+1)) /tmp + tmp = MAX(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i,j+1) + G%mask2dCu(i-1,j) + G%mask2dCu(i-1,j+1) ) ) + taux = ( G%mask2dCu(i ,j )*taux_u(i ,j ) + G%mask2dCu(i ,j+1)*taux_u(i ,j+1) & + + G%mask2dCu(i-1,j )*taux_u(i-1,j ) + G%mask2dCu(i-1,j+1)*taux_u(i-1,j+1) ) / tmp + ustar2_v(i,J) = sqrt( tauy_v(i,J)*tauy_v(i,J) + taux*taux ) + omega_w2x_v(i,J) = atan2( tauy_v(i,J) , taux ) + tauyDG_v(i,J,1) = tauy_v(i,J) depth = 0.0 do k = 1, nz depth = depth + CS%h_v(i,J,k) @@ -339,98 +282,80 @@ subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, U endif enddo enddo -endif !w predictor step - -! Thickness weighted diagnostic interpolations ! Copy Implicit [uv]i to [uv]old - call pass_vector(ui,vi, G%Domain, To_All+Scalar_Pair) - vi_u(:,:,:) = 0. - ui_v(:,:,:) = 0. - tauxDG_u(:,:,:) = 0.0 - tauyDG_v(:,:,:) = 0.0 - tauxDG_v(:,:,:) = 0. - tauyDG_u(:,:,:) = 0. + + if (CS%debug) then + call uvchksum("surface tau[xy]_[uv] ", taux_u, tauy_v, G%HI, haloshift=1, scalar_pair=.true.) + call uvchksum("ustar2 ",ustar2_u, ustar2_v, G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum(" hbl ", hbl_u , hbl_v , G%HI, haloshift=0, scalar_pair=.true.) + endif + + ! Compute downgradient stresses do k = 1, nz - kp = MIN( k+1 , nz) - do j = js-1 ,je+1 - do I = Isq-1, Ieq+1 - tauxDG_u(I,j,k+1) = CS%a_u(I,j,kp) * (ui(I,j,k) - ui(I,j,kp)) + kp1 = MIN( k+1 , nz) + do j = js ,je + do I = Isq , Ieq + tauxDG_u(I,j,k+1) = CS%a_u(I,j,kp1) * (ui(I,j,k) - ui(I,j,kp1)) enddo enddo - do J = Jsq-1, Jeq+1 - do i = is-1, ie+1 - tauyDG_v(i,J,k+1) = CS%a_v(i,J,kp) * (vi(i,J,k) - vi(i,J,kp)) + do J = Jsq , Jeq + do i = is , ie + tauyDG_v(i,J,k+1) = CS%a_v(i,J,kp1) * (vi(i,J,k) - vi(i,J,kp1)) enddo enddo + enddo + + call pass_vector(tauxDG_u, tauyDG_v , G%Domain, To_All) + call pass_vector(ui,vi, G%Domain, To_All) + tauxDG_v(:,:,:) = 0. + tauyDG_u(:,:,:) = 0. + ! Thickness weighted interpolations + do k = 1, nz ! v to u points do j = js , je do I = Isq, Ieq - vi_u(I,j,k) = set_v_at_u(vi, h, G, GV, I, j, k, G%mask2dCv, OBC) - tauyDG_u(I,j,k)= set_v_at_u(tauyDG_v, h, G, GV, I, j, k, G%mask2dCv, OBC) + tauyDG_u(I,j,k) = set_v_at_u(tauyDG_v, h, G, GV, I, j, k, G%mask2dCv, OBC) enddo enddo ! u to v points do J = Jsq, Jeq do i = is, ie - ui_v(I,j,k) = set_u_at_v(ui, h, G, GV, i, J, k, G%mask2dCu, OBC) - tauxDG_v(i,J,k)= set_u_at_v(tauxDG_u, h, G, GV, i, J, k, G%mask2dCu, OBC) + tauxDG_v(i,J,k) = set_u_at_v(tauxDG_u, h, G, GV, i, J, k, G%mask2dCu, OBC) enddo enddo enddo if (CS%debug) then - call uvchksum(" vi_u ui_v ", vi_u , ui_v , G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum(" tauyDG_u tauxDG_v",tauyDG_u,tauxDG_v, G%HI, haloshift=0, scalar_pair=.true.) endif -! compute angles, tau2x_[u,v], tau2w_[u,v], tau2s_[u,v], s2x_[u,v], s2w_[u,v] and stress mag tau_[u,v] - omega_tau2x_u(:,:,:) = 0.0 - omega_tau2x_v(:,:,:) = 0.0 + ! compute angles, tau2x_[u,v], tau2w_[u,v], tau2s_[u,v], s2w_[u,v] and stress mag tau_[u,v] omega_tau2w_u(:,:,:) = 0.0 omega_tau2w_v(:,:,:) = 0.0 omega_tau2s_u(:,:,:) = 0.0 omega_tau2s_v(:,:,:) = 0.0 - omega_s2x_u(:,:,:) = 0.0 - omega_s2x_v(:,:,:) = 0.0 - omega_s2w_u(:,:,:) = 0. - omega_s2w_v(:,:,:) = 0. tau_u(:,:,:) = 0.0 tau_v(:,:,:) = 0.0 -!w Default implicit (I) stress magnitude tau_[uv] & direction Omega_tau2(w,s,x)_[uv] Profiles + !w Default implicit (I) stress magnitude tau_[uv] & direction Omega_tau2(w,s,x)_[uv] Profiles do j = js,je do I = Isq,Ieq if( (G%mask2dCu(I,j) > 0.5) ) then - tauyDG_u(I,j,1) = tauy_u(I,j) ! SURFACE - tau_u(I,j,1) = ustar2_u(I,j) !w stress magnitude + ! SURFACE + tauyDG_u(I,j,1) = ustar2_u(I,j) * cos(omega_w2x_u(I,j)) + tau_u(I,j,1) = ustar2_u(I,j) Omega_tau2w_u(I,j,1) = 0.0 - Omega_tau2x_u(I,j,1) = omega_w2x_u(I,j) Omega_tau2s_u(I,j,1) = 0.0 - omega_s2x_u(I,j,1) = omega_w2x_u(I,j) - omega_s2w_u(I,j,1) = 0.0 + ! WGL; TODO: can we use set_v_at_u to get tauyDG_u? do k=1,nz kp1 = MIN(k+1 , nz) tau_u(I,j,k+1) = sqrt( tauxDG_u(I,j,k+1)*tauxDG_u(I,j,k+1) + tauyDG_u(I,j,k+1)*tauyDG_u(I,j,k+1)) - Omega_tau2x_u(I,j,k+1) = atan2( tauyDG_u(I,j,k+1) , tauxDG_u(I,j,k+1) ) - - du = ui(i,J,k) - ui(i,J,kp1) - dv = vi_u(i,J,k) - vi_u(i,J,kp1) - omega_s2x_u(I,j,k+1) = atan2( dv , du) !w ~ Omega_tau2x - - omega_tmp = Omega_tau2x_u(I,j,k+1) - omega_w2x_u(I,j) + Omega_tau2x = atan2( tauyDG_u(I,j,k+1) , tauxDG_u(I,j,k+1) ) + omega_tmp = Omega_tau2x - omega_w2x_u(I,j) if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi Omega_tau2w_u(I,j,k+1) = omega_tmp - - omega_tmp = Omega_tau2x_u(I,j,k+1) - omega_s2x_u(I,j,k+1) - if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi - if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi - Omega_tau2s_u(I,j,k+1) = omega_tmp !w ~ 0 - - omega_tmp = omega_s2x_u(I,j,k+1) - omega_w2x_u(I,j) - if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi - if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi - omega_s2w_u(I,j,k+1) = omega_tmp !w ~ Omega_tau2w - + Omega_tau2s_u(I,j,k+1) = 0.0 enddo endif enddo @@ -438,49 +363,30 @@ subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, U do J = Jsq, Jeq do i = is, ie if( (G%mask2dCv(i,J) > 0.5) ) then - tauxDG_v(i,J,1) = taux_v(i,J) ! SURFACE + ! SURFACE + tauxDG_v(i,J,1) = ustar2_v(i,J) * sin(omega_w2x_v(i,J)) tau_v(i,J,1) = ustar2_v(i,J) Omega_tau2w_v(i,J,1) = 0.0 - Omega_tau2x_v(i,J,1) = omega_w2x_v(i,J) Omega_tau2s_v(i,J,1) = 0.0 - omega_s2x_v(i,J,1) = omega_w2x_v(i,J) - omega_s2w_v(i,J,1) = 0.0 + ! WGL; TODO: can we use set_u_at_v to get tauxDG_v? do k=1,nz-1 kp1 = MIN(k+1 , nz) tau_v(i,J,k+1) = sqrt ( tauxDG_v(i,J,k+1)*tauxDG_v(i,J,k+1) + tauyDG_v(i,J,k+1)*tauyDG_v(i,J,k+1) ) - Omega_tau2x_v(i,J,k+1) = atan2( tauyDG_v(i,J,k+1) , tauxDG_v(i,J,k+1) ) - - du = ui_v(i,J,k) - ui_v(i,J,kp1) - dv = vi(i,J,k) - vi(i,J,kp1) - omega_s2x_v(i,J,k+1) = atan2( dv , du ) !~ Omega_tau2x - - omega_tmp = Omega_tau2x_v(i,J,k+1) - omega_w2x_v(i,J) + omega_tau2x = atan2( tauyDG_v(i,J,k+1) , tauxDG_v(i,J,k+1) ) + omega_tmp = omega_tau2x - omega_w2x_v(i,J) if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi Omega_tau2w_v(i,J,k+1) = omega_tmp - - omega_tmp = Omega_tau2x_v(i,J,k+1) - omega_s2x_v(i,J,k+1) - if (omega_tmp .gt. pi ) omega_tmp = omega_tmp - 2.*pi - if (omega_tmp .le. (0.-pi) ) omega_tmp = omega_tmp + 2.*pi - Omega_tau2s_v(i,J,k+1) = omega_tmp !w ~ 0 - - omega_tmp = omega_s2x_v(i,J,k+1) - omega_w2x_v(i,J) - if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi - if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi - omega_s2w_v(i,J,k+1) = omega_tmp !w ~ Omega_tau2w - + Omega_tau2s_v(i,J,k+1) = 0.0 enddo endif enddo enddo -! ********************************************************************************************** -!w Parameterized stress orientation from the wind at interfaces (tau2x) and centers (tau2x) OVERWRITE to kbl-interface above hbl - du_rot(:,:,:) = 0.0 - dv_rot(:,:,:) = 0.0 - mask3d_u(:,:,:) = 0.0 - mask3d_v(:,:,:) = 0.0 - do j = js,je !w U-points + + ! Parameterized stress orientation from the wind at interfaces (tau2x) + ! and centers (tau2x) OVERWRITE to kbl-interface above hbl + do j = js,je do I = Isq,Ieq if( (G%mask2dCu(I,j) > 0.5) ) then kbld = MIN( (kbl_u(I,j)) , (nz-2) ) @@ -488,238 +394,151 @@ subroutine vertFPmix(LU_pred, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, U !w if ( tau_u(I,j,kbld+2) > tau_u(I,j,kbld+1) ) kbld = kbld + 1 tauh = tau_u(I,j,kbld+1) + GV%H_subroundoff - omega_tau2wh = omega_tau2w_u(I,j,kbld+1) - - depth = 0. ! surface boundary conditions + ! surface boundary conditions + depth = 0. tauNLup = 0.0 do k=1, kbld depth = depth + CS%h_u(I,j,k) - if ( (L19 > 0) ) then - sigma = MIN ( 1.0 , depth / hbl_u(i,j) ) - G_sig = MIN ( 0.287 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (1.74392*sigma - 2.58538) ) ) - - tau_MAG = (ustar2_u(I,j) * (1.-sigma) ) + (tauh * sigma ) !w linear stress mag - omega_s2x = Omega_tau2x_u(I,j,k+1) - cos_tmp = tauxDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff) - sin_tmp = tauyDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff) - Wind_x = ustar2_u(I,j) * cos(omega_w2x_u(I,j)) !w taux_u primary - Wind_y = ustar2_u(I,j) * sin(omega_w2x_u(I,j)) !w tauy_u interpolated - tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) !wind in x' - tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) !WCG in y' - omega_w2s = atan2( tauNL_CG , tauNL_DG ) !W wind to shear x' (limiter) - omega_s2w = 0.0-omega_w2s - tauNL_CG = Cemp_CG * G_sig * tauNL_CG -!OPTIONS - if(L19 .eq. 1) then !A L19=1 - tau_MAG = MAX( tau_MAG , tauNL_CG ) - tauNL_DG = sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - tau_u(I,j,k+1) - endif - - if(L19 .eq. 2) then !B L19=2 - tauNL_CG = MIN( tauNL_CG , tau_MAG ) - tauNL_DG = sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - tau_u(I,j,k+1) - endif - - if(L19 .eq. 3) then !C L19=3 - tauNL_DG = tau_MAG - tau_u(I,j,k+1) - tau_MAG = sqrt( tau_MAG*tau_MAG + tauNL_CG*tauNL_CG ) - endif - omega_tmp = atan2( tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG) ) !W Limiters - - tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) !w back to x,y coordinates - tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) - tauNLdn = tauNL_X ! SOLUTION - du_rot(I,j,k) = (tauNLup - tauNLdn) * (dt/CS%h_u(I,j,k) + GV%H_subroundoff) - tauNLup = tauNLdn - - mask3d_u(I,j,k) = tauNL_CG / (tau_MAG) !W (tauNLup - tauNLdn) - mask3d_v(i,j,k) = (tau_u(I,j,k+1)+tauNL_DG) / (tau_MAG) - ! DIAGNOSTICS - tau_u(I,j,k+1) = sqrt( (tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2 ) - omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y) , (tauxDG_u(I,j,k+1) + tauNL_X) ) - - omega_tau2w = omega_tau2x - omega_w2x_u(I,j) - if (omega_tau2w .gt. pi ) omega_tau2w = omega_tau2w - 2.*pi - if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi - Omega_tau2w_u(I,j,k+1) = omega_tau2w - Omega_tau2s_u(I,j,k+1) = omega_tmp !W omega_tau2x - Omega_tau2x_u(I,j,k+1) - Omega_tau2x_u(I,j,k+1) = 0.0 - omega_w2s !W omega_s2x !W 0.0 - omega_w2s !W omega_tau2x - - endif + sigma = MIN ( 1.0 , depth / hbl_u(i,j) ) + + ! linear stress mag + tau_MAG = (ustar2_u(I,j) * (1.-sigma) ) + (tauh * sigma ) + cos_tmp = tauxDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff) + sin_tmp = tauyDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff) + + ! rotate to wind coordinates + Wind_x = ustar2_u(I,j) * cos(omega_w2x_u(I,j)) + Wind_y = ustar2_u(I,j) * sin(omega_w2x_u(I,j)) + tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) + tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) + omega_w2s = atan2( tauNL_CG , tauNL_DG ) + omega_s2w = 0.0-omega_w2s + tauNL_CG = Cemp_CG * G_sig(sigma) * tauNL_CG + tau_MAG = MAX( tau_MAG , tauNL_CG ) + tauNL_DG = sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - tau_u(I,j,k+1) + + ! back to x,y coordinates + tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) + tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) + tauNLdn = tauNL_X + + ! nonlocal increment and update to uold + du = (tauNLup - tauNLdn) * (dt/CS%h_u(I,j,k) + GV%H_subroundoff) + ui(I,j,k) = uold(I,j,k) + du + uold(I,j,k) = du + tauNLup = tauNLdn + + ! diagnostics + FPdiag_u(I,j,k+1) = tauNL_CG / (tau_MAG + GV%H_subroundoff) + Omega_tau2s_u(I,j,k+1) = atan2( tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG) ) + tau_u(I,j,k+1) = sqrt( (tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2 ) + omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y) , (tauxDG_u(I,j,k+1) + tauNL_X) ) + omega_tau2w = omega_tau2x - omega_w2x_u(I,j) + if (omega_tau2w >= pi ) omega_tau2w = omega_tau2w - 2.*pi + if (omega_tau2w <= (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi + Omega_tau2w_u(I,j,k+1) = omega_tau2w + enddo + do k= kbld+1, nz + ui(I,j,k) = uold(I,j,k) + uold(I,j,k) = 0.0 enddo endif enddo enddo -!w V-point dv increment %%%%%%%%%%%%%%%%%%%%%%%%%%%% + + ! v-point dv increment do J = Jsq,Jeq do i = is,ie if( (G%mask2dCv(i,J) > 0.5) ) then kbld = MIN( (kbl_v(i,J)) , (nz-2) ) if ( tau_v(i,J,kbld+2) > tau_v(i,J,kbld+1) ) kbld = kbld + 1 tauh = tau_v(i,J,kbld+1) - omega_tau2wh = omega_tau2w_u(I,j,kbld+1) - depth = 0. !surface boundary conditions + !surface boundary conditions + depth = 0. tauNLup = 0.0 do k=1, kbld depth = depth + CS%h_v(i,J,k) - if ( (L19 > 0) ) then - sigma = MIN ( 1.0 , (depth ) / hbl_v(I,J) ) - G_sig = MIN ( 0.287 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (1.74392*sigma - 2.58538) ) ) - - tau_MAG = (ustar2_v(i,J) * (1.-sigma) ) + (tauh * sigma ) !w linear stress - omega_s2x = Omega_tau2x_v(i,J,k+1) - cos_tmp = tauxDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) - sin_tmp = tauyDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) - Wind_x = ustar2_v(i,J) * cos(omega_w2x_v(i,J)) !w taux_v interpolated - Wind_y = ustar2_v(i,J) * sin(omega_w2x_v(i,J)) !w tauy_v primary - tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) - tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) !w WCG - omega_w2s = atan2( tauNL_CG , tauNL_DG ) ! tau2x' limiter - omega_s2w = 0.0 - omega_w2s - tauNL_CG = Cemp_CG * G_sig * tauNL_CG -!OPTIONS - if(L19 .eq. 1) then !A L19=1 - tau_MAG = MAX( tau_MAG , tauNL_CG ) - tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - endif - - if(L19 .eq. 2) then !B L19=2 - tauNL_CG = MIN( tauNL_CG , tau_MAG ) - tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - endif - - if(L19 .eq. 3) then !C L19=3 - tauNL_DG = 0.0 - tau_v(i,J,k+1) + tau_MAG - tau_MAG = sqrt( tau_MAG*tau_MAG + tauNL_CG*tauNL_CG ) - endif + sigma = MIN ( 1.0 , (depth ) / hbl_v(I,J) ) + + ! linear stress + tau_MAG = (ustar2_v(i,J) * (1.-sigma) ) + (tauh * sigma ) + cos_tmp = tauxDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) + sin_tmp = tauyDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) + + ! rotate into wind coordinate + Wind_x = ustar2_v(i,J) * cos(omega_w2x_v(i,J)) + Wind_y = ustar2_v(i,J) * sin(omega_w2x_v(i,J)) + tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) + tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) + omega_w2s = atan2( tauNL_CG , tauNL_DG ) + omega_s2w = 0.0 - omega_w2s + tauNL_CG = Cemp_CG * G_sig(sigma) * tauNL_CG + tau_MAG = MAX( tau_MAG , tauNL_CG ) + tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) + + ! back to x,y coordinate + tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) + tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) + tauNLdn = tauNL_Y + dv = (tauNLup - tauNLdn) * (dt/(CS%h_v(i,J,k)) ) + vi(i,J,k) = vold(i,J,k) + dv + vold(i,J,k) = dv + tauNLup = tauNLdn + + ! diagnostics + FPdiag_v(i,j,k+1) = tau_MAG / tau_v(i,J,k+1) + Omega_tau2s_v(i,J,k+1) = atan2( tauNL_CG , tau_v(i,J,k+1) + tauNL_DG ) + tau_v(i,J,k+1) = sqrt( (tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2 ) + omega_tau2x = atan2( (tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X) ) + omega_tau2w = omega_tau2x - omega_w2x_v(i,J) + if (omega_tau2w .gt. pi ) omega_tau2w = omega_tau2w - 2.*pi + if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi + Omega_tau2w_v(i,J,k+1) = omega_tau2w + enddo - omega_tmp = atan2( tauNL_CG , tau_v(i,J,k+1) + tauNL_DG ) !W LIMITERS as (tauNL_CG / tau_MAG) - - tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) ! back to x,y coordinate - tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) - tauNLdn = tauNL_Y - dv_rot(i,J,k) = (tauNLup - tauNLdn) * (dt/(CS%h_v(i,J,k)) ) ! SOLUTION - tauNLup = tauNLdn - ! DIAGNOSTICS - tau_v(i,J,k+1) = sqrt( (tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2 ) - omega_tau2x = atan2( (tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X) ) - omega_tau2w = omega_tau2x - omega_w2x_v(i,J) - if (omega_tau2w .gt. pi ) omega_tau2w = omega_tau2w - 2.*pi - if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi - - Omega_tau2w_v(i,J,k+1) = omega_tau2w - Omega_tau2s_v(i,J,k+1) = omega_tmp !W omega_tau2x - Omega_tau2x_v(i,J,k+1) - Omega_tau2x_v(i,J,k+1) = 0.0 - omega_w2s !W omega_s2x !W 0.0 - omega_w2s !W omega_tau2x - endif + do k= kbld+1, nz + vi(i,J,k) = vold(i,J,k) + vold(i,J,k) = 0.0 enddo endif enddo enddo + if (CS%debug) then call uvchksum("FP-tau_[uv] ", tau_u, tau_v, G%HI, haloshift=0, scalar_pair=.true.) - call uvchksum("FP-omega_s2x ",omega_s2x_u,omega_s2x_v,G%HI,haloshift=0,scalar_pair=.true.) - call uvchksum("FP-omega_s2w ",omega_s2w_u,omega_s2w_v,G%HI,haloshift=0,scalar_pair=.true.) - call uvchksum("FP-omega_t2w ",omega_tau2x_u,omega_tau2x_v,G%HI,haloshift=0,scalar_pair=.true.) - call uvchksum("FP-omega_t2x ",omega_tau2x_u ,omega_tau2x_v ,G%HI,haloshift=0,scalar_pair=.true.) - call uvchksum("FP-d[uv]_rot ",du_rot, dv_rot, G%HI, haloshift=0,scalar_pair=.true.) - call uvchksum("FP-d[uv]_out ",uold , vold , G%HI, haloshift=0,scalar_pair=.true.) endif -!w OUTPUT - do k=1,nz - do j = js,je - do I = Isq,Ieq - ui(I,j,k) = uold(I,j,k) + du_rot(I,j,k) - uold(I,j,k) = du_rot(I,j,k) - enddo - enddo - do J = Jsq,Jeq - do i = is,ie - vi(i,J,k) = vold(i,J,k) + dv_rot(i,J,k) - vold(i,J,k) = dv_rot(i,J,k) - enddo - enddo - enddo - -if( LU_pred .eq. .false. ) then !W CONDITION DIAGNOSTIC OUTPUT THEN POST - do j = js,je - do I = Isq,Ieq - if( (G%mask2dCu(I,j) > 0.5) ) then - kbld = kbl_u(I,j) - ustar2 = ustar2_u(I,j) - tau_u(I,j,1) = tau_u(I,j,1) / ustar2 - Omega_tau2w_u(I,j,1) = Omega_tau2w_u(I,j,1) / pi - Omega_tau2x_u(I,j,1) = Omega_tau2x_u(I,j,1) / pi - Omega_tau2s_u(I,j,1) = Omega_tau2s_u(I,j,1) / pi - do k=1,nz - !w mask3d_u(I,j,k) = - tau_u(I,j,k+1) = tau_u(I,j,k+1) / ustar2 - Omega_tau2w_u(I,j,k+1) = Omega_tau2w_u(I,j,k+1) /pi - Omega_tau2x_u(I,j,k+1) = Omega_tau2x_u(I,j,k+1) /pi - Omega_tau2s_u(I,j,k+1) = Omega_tau2s_u(I,j,k+1) /pi - if( k .eq. kbld+2) then - tau_u(I,j,k) = 0.0 - tau_u(I,j,k) - Omega_tau2w_u(I,j,k) = 1.05 - Omega_tau2x_u(I,j,k) = 1.05 - Omega_tau2s_u(I,j,k) = 1.05 - endif - enddo - Omega_tau2x_u(I,j,nz+1) = omega_w2x_u(I,j) / pi - mask3d_u(I,j,nz) = ustar2_u(I,j) - mask3d_u(I,j,nz-1) = sqrt(taux_u(I,j)*taux_u(I,j) + tauy_u(I,j)*tauy_u(I,j) ) - endif - enddo - enddo - do J = Jsq,Jeq !w v-points - do i = is,ie - if( (G%mask2dCv(i,J) > 0.5) ) then - kbld = kbl_v(i,J) - ustar2 = ustar2_v(i,J) - tau_v(i,J,1) = tau_v(i,J,1) / ustar2 - Omega_tau2w_v(i,J,1) = Omega_tau2w_v(i,J,1) / pi - Omega_tau2x_v(i,J,1) = Omega_tau2x_v(i,J,1) / pi - Omega_tau2s_v(i,J,1) = Omega_tau2s_v(i,J,1) / pi - do k=1,nz - !w mask3d_v(i,J,k) = tauxDG_v(i,J,k) !w vi(i,J,k) - v(i,J,k) !w dv_rot(i,J,k) - tau_v(i,J,k+1) = tau_v(i,J,k+1) / ustar2 - Omega_tau2w_v(i,J,k+1) = Omega_tau2w_v(i,J,k+1) /pi - Omega_tau2x_v(i,J,k+1) = Omega_tau2x_v(i,J,k+1) /pi - Omega_tau2s_v(i,J,k+1) = Omega_tau2s_v(i,J,k+1) /pi - if( k .eq. kbld+2) then - tau_v(i,J,k) = 0.0 - tau_v(i,J,k) - Omega_tau2w_v(i,J,k) = 1.05 - Omega_tau2x_v(i,J,k) = 1.05 - Omega_tau2s_v(i,J,k) = 1.05 - endif - enddo - Omega_tau2x_v(i,J,nz+1) = omega_w2x_v(i,J) / pi - mask3d_v(i,J,nz) = ustar2_v(i,J) - mask3d_v(i,J,nz-1) = sqrt(taux_v(i,J)*taux_v(i,J) + tauy_v(i,J)*tauy_v(i,J) ) - endif - enddo - enddo - - if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) - if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) - if (CS%id_FPtau2s_u > 0) call post_data(CS%id_FPtau2s_u, omega_tau2s_u, CS%diag) - if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag) - if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag) - if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag) - if (CS%id_FPtau2x_u > 0) call post_data(CS%id_FPtau2x_u, omega_tau2x_u, CS%diag) - if (CS%id_FPtau2x_v > 0) call post_data(CS%id_FPtau2x_v, omega_tau2x_v, CS%diag) - if (CS%id_FPmask_u > 0) call post_data(CS%id_FPmask_u, mask3d_u, CS%diag) - if (CS%id_FPmask_v > 0) call post_data(CS%id_FPmask_v, mask3d_v, CS%diag) - if (CS%id_FPhbl_u > 0) call post_data(CS%id_FPhbl_u, hbl_u, CS%diag) - if (CS%id_FPhbl_v > 0) call post_data(CS%id_FPhbl_v, hbl_v, CS%diag) - - if (cs%debug) then - call uvchksum("post viscFPmix [ui,vi]",ui,vi,G%HI,haloshift=0,scalar_pair=.true.) + ! GMM; TODO: can you make the arrays used below allocatable? + if(L_diag) then + if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) + if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) + if (CS%id_FPtau2s_u > 0) call post_data(CS%id_FPtau2s_u, omega_tau2s_u, CS%diag) + if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag) + if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag) + if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag) + if (CS%id_FPdiag_u > 0) call post_data(CS%id_FPdiag_u, FPdiag_u, CS%diag) + if (CS%id_FPdiag_v > 0) call post_data(CS%id_FPdiag_v, FPdiag_v, CS%diag) + if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag) endif -endif ! LU_pred = false end subroutine vertFPmix +!> Returns the empirical shape-function given sigma. +real function G_sig(sigma) + real , intent(in) :: sigma !< non-dimensional normalized boundary layer depth [m] + + ! local variables + real :: p1, c2, c3 !< parameters used to fit and match empirycal shape-functions. + + ! parabola + p1 = 0.287 + ! cubic function + c2 = 1.74392 + c3 = 2.58538 + G_sig = MIN ( p1 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (c2*sigma - c3) ) ) +end function G_sig + !> Perform a fully implicit vertical diffusion !! of momentum. Stress top and bottom boundary conditions are used. !! @@ -2406,37 +2225,24 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', & thickness_units, conversion=GV%H_to_MKS) - !w FPmix - CS%id_FPhbl_u = register_diag_field('ocean_model', 'FPhbl_u', diag%axesCu1, Time, & - 'Boundary-Layer Depth (u-points)','m') !w , conversion=GV%H_to_MKS) - CS%id_FPhbl_v = register_diag_field('ocean_model', 'FPhbl_v', diag%axesCv1, Time, & - 'Boundary-Layer Depth (v-points)','m') - - CS%id_FPmask_u = register_diag_field('ocean_model', 'FPmask_u', diag%axesCuL, Time, & - 'FP overwrite mask (u-points)','binary') - CS%id_FPmask_v = register_diag_field('ocean_model', 'FPmask_v', diag%axesCvL, Time, & - 'FP overwrite mask (v-points)','binary') - + CS%id_FPw2x = register_diag_field('ocean_model', 'FPw2x', diag%axesT1, Time, & + 'Wind direction from x-axis','radians') + CS%id_FPdiag_u = register_diag_field('ocean_model', 'FPdiag_u', diag%axesCui, Time, & + 'FP diagmostic (u-points)','binary') + CS%id_FPdiag_v = register_diag_field('ocean_model', 'FPdiag_v', diag%axesCvi, Time, & + 'FP diagnostic (v-points)','binary') CS%id_tauFP_u = register_diag_field('ocean_model', 'tauFP_u', diag%axesCui, Time, & - 'Stress Mag Profile (u-points)', 'm2 s-2') !w , conversion=GV%H_to_MKS) + 'Stress Mag Profile (u-points)', 'm2 s-2') CS%id_tauFP_v = register_diag_field('ocean_model', 'tauFP_v', diag%axesCvi, Time, & - 'Stress Mag Profile (v-points)', 'm2 s-2') !w , conversion=GV%H_to_MKS) - + 'Stress Mag Profile (v-points)', 'm2 s-2') CS%id_FPtau2s_u = register_diag_field('ocean_model', 'FPtau2s_u', diag%axesCui, Time, & - 'stress from shear direction (u-points)', 'pi ') + 'stress from shear direction (u-points)', 'radians ') CS%id_FPtau2s_v = register_diag_field('ocean_model', 'FPtau2s_v', diag%axesCvi, Time, & - 'stress from shear direction (v-points)', 'pi ') - + 'stress from shear direction (v-points)', 'radians') CS%id_FPtau2w_u = register_diag_field('ocean_model', 'FPtau2w_u', diag%axesCui, Time, & - 'stress from wind direction (u-points)', 'pi ') + 'stress from wind direction (u-points)', 'radians') CS%id_FPtau2w_v = register_diag_field('ocean_model', 'FPtau2w_v', diag%axesCvi, Time, & - 'stress from wind direction (v-points)', 'pi ') - - CS%id_FPtau2x_u = register_diag_field('ocean_model', 'FPs2w_u', diag%axesCui, Time, & - 'shear from wind (u-points)', 'pi ') - CS%id_FPtau2x_v = register_diag_field('ocean_model', 'FPs2w_v', diag%axesCvi, Time, & - 'shear from wind (v-points)', 'pi ' - ! w - end + 'stress from wind direction (v-points)', 'radians') CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, Time, & 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) From 7624a83b810e21616b089a772398d7d287ca7feb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 24 May 2022 14:51:31 -0600 Subject: [PATCH 005/213] Add missing use for vertFPmix --- src/core/MOM_dynamics_split_RK2.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f6cf456f98..b74df389b3 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -64,7 +64,7 @@ module MOM_dynamics_split_RK2 use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant use MOM_vert_friction, only : vertvisc_init, vertvisc_end, vertvisc_CS -use MOM_vert_friction, only : updateCFLtruncationValue +use MOM_vert_friction, only : updateCFLtruncationValue, vertFPmix use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF From 864506e850d5ec4f72457e01bf3dea6305c8eb8c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 24 May 2022 14:56:17 -0600 Subject: [PATCH 006/213] Add omega_w2x to fluxes and forces omega_w2x is the counter-clockwise angle of the wind stress with respect to the horizontal abscissa (x-coordinate) at tracer points [rad]. This variable is needed in the vertPFmix subroutine. --- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 3 +++ src/core/MOM_forcing_type.F90 | 24 ++++++++++++++++++- .../vertical/MOM_vert_friction.F90 | 1 + 3 files changed, 27 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 69841bf84a..41572b969e 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -311,6 +311,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., & press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug, & cfc=CS%use_CFC, hevap=CS%enthalpy_cpl) + call safe_alloc_ptr(fluxes%omega_w2x,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -721,6 +722,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%omega_w2x,isd,ied,jsd,jed) if (CS%rigid_sea_ice) then call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -880,6 +882,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + forces%omega_w2x(i,j) = atan(tauy_at_h(i,j), taux_at_h(i,j)) enddo ; enddo call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) else ! C-grid wind stresses. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index d4afabc2de..9d95e7159f 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -67,6 +67,7 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & + omega_w2x => NULL(), & !< the counter-clockwise angle of the wind stress with respect ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. ustar_gustless => NULL() !< surface friction velocity scale without any !! any augmentation for gustiness [Z T-1 ~> m s-1]. @@ -221,7 +222,9 @@ module MOM_forcing_type taux => NULL(), & !< zonal wind stress [R L Z T-2 ~> Pa] tauy => NULL(), & !< meridional wind stress [R L Z T-2 ~> Pa] ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. - net_mass_src => NULL() !< The net mass source to the ocean [R Z T-1 ~> kg m-2 s-1] + net_mass_src => NULL(), & !< The net mass source to the ocean [R Z T-1 ~> kg m-2 s-1] + omega_w2x => NULL() !< the counter-clockwise angle of the wind stress with respect + !! to the horizontal abscissa (x-coordinate) at tracer points [rad]. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() @@ -357,6 +360,7 @@ module MOM_forcing_type integer :: id_taux = -1 integer :: id_tauy = -1 integer :: id_ustar = -1 + integer :: id_omega_w2x = -1 integer :: id_psurf = -1 integer :: id_TKE_tidal = -1 @@ -1320,6 +1324,9 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & 'm s-1', conversion=US%Z_to_m*US%s_to_T) + handles%id_omega_w2x = register_diag_field('ocean_model', 'omega_w2x', diag%axesT1, Time, & + 'Counter-clockwise angle of the wind stress from the horizontal axis.', 'rad') + if (present(use_berg_fluxes)) then if (use_berg_fluxes) then handles%id_ustar_berg = register_diag_field('ocean_model', 'ustar_berg', diag%axesT1, Time, & @@ -2164,6 +2171,11 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) enddo ; enddo endif + if (associated(forces%omega_w2x) .and. associated(fluxes%omega_w2x)) then + do j=js,je ; do i=is,ie + fluxes%omega_w2x(i,j) = forces%omega_w2x(i,j) + enddo ; enddo + endif if (do_pres) then if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then do j=js,je ; do i=is,ie @@ -2295,6 +2307,11 @@ subroutine copy_back_forcing_fields(fluxes, forces, G) enddo ; enddo endif + if (associated(forces%omega_w2x) .and. associated(fluxes%omega_w2x)) then + do j=js,je ; do i=is,ie + forces%omega_w2x(i,j) = fluxes%omega_w2x(i,j) + enddo ; enddo + endif end subroutine copy_back_forcing_fields !> Offer mechanical forcing fields for diagnostics for those @@ -2948,6 +2965,9 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & call post_data(handles%id_ustar, fluxes%ustar, diag) + if ((handles%id_omega_w2x > 0) .and. associated(fluxes%omega_w2x)) & + call post_data(handles%id_omega_w2x, fluxes%omega_w2x, diag) + if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) & call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) @@ -3264,6 +3284,7 @@ end subroutine myAlloc subroutine deallocate_forcing_type(fluxes) type(forcing), intent(inout) :: fluxes !< Forcing fields structure + if (associated(fluxes%omega_w2x)) deallocate(fluxes%omega_w2x) if (associated(fluxes%ustar)) deallocate(fluxes%ustar) if (associated(fluxes%ustar_gustless)) deallocate(fluxes%ustar_gustless) if (associated(fluxes%buoy)) deallocate(fluxes%buoy) @@ -3325,6 +3346,7 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%taux)) deallocate(forces%taux) if (associated(forces%tauy)) deallocate(forces%tauy) if (associated(forces%ustar)) deallocate(forces%ustar) + if (associated(forces%omega_w2x)) deallocate(forces%omega_w2x) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 1d4f7bf646..605fda5dce 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -25,6 +25,7 @@ module MOM_vert_friction use MOM_variables, only : ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS +use MOM_set_visc, only : set_v_at_u, set_u_at_v implicit none ; private #include From 9b4bd84b5e3c7ac1cf67a19670e7197c9ea4cdf5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 21 Jun 2022 15:17:51 -0600 Subject: [PATCH 007/213] Add mssing call to get_param for FPMIX This line of code was lost during the last merge. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b74df389b3..288d7d9092 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -164,7 +164,7 @@ module MOM_dynamics_split_RK2 !! Euler (1) [nondim]. 0 is often used. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_OBC !< If true, do debugging calls for open boundary conditions. - logical :: fpmix !< If true, apply profiles of MTM flux magnitude and direction. + logical :: fpmix !< If true, applies profiles of momentum flux magnitude and direction. logical :: module_is_initialized = .false. !< Record whether this module has been initialized. @@ -327,6 +327,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. + ! GMM, TODO: make these allocatable? real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uold real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vold ! uold and vold are the velocities before vert_visc is applied. These arrays @@ -1278,6 +1279,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param "If true, use the summed layered fluxes plus an "//& "adjustment due to the change in the barotropic velocity "//& "in the barotropic continuity equation.", default=.true.) + call get_param(param_file, mdl, "FPMIX", CS%fpmix, & + "If true, apply profiles of momentum flux magnitude and "//& + " direction", default=.false.) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) From 2ba1af11ef927a520e044c29f003f33f06ad11e1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Oct 2022 09:38:51 -0400 Subject: [PATCH 008/213] +Created remapping_attic.F90 Created the new module remapping_attic to hold older versions of remapping code that are no longer used by MOM6. The subroutines is PosSumErrSignificant, remapByProjection, remapByDeltaZ and integrateReconOnInterval were moved to remapping_attic, where they can be tested by calling remapping_attic_unit_tests. The hard-coded old_algorithm logical module variable and the code it wraps were also eliminated. Also added a schematic description of the units of the real variables in the various routines in MOM_remapping and corrected some spelling errors. All answers are bitwise identical. --- src/ALE/MOM_remapping.F90 | 792 +++++++----------------------------- src/ALE/remapping_attic.F90 | 648 +++++++++++++++++++++++++++++ 2 files changed, 785 insertions(+), 655 deletions(-) create mode 100644 src/ALE/remapping_attic.F90 diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index faed4ac6be..061894711c 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -5,23 +5,22 @@ module MOM_remapping ! Original module written by Laurent White, 2008.06.09 use MOM_error_handler, only : MOM_error, FATAL +use MOM_io, only : stdout, stderr use MOM_string_functions, only : uppercase use regrid_edge_values, only : edge_values_explicit_h4, edge_values_implicit_h4 use regrid_edge_values, only : edge_values_implicit_h4, edge_values_implicit_h6 use regrid_edge_values, only : edge_slopes_implicit_h3, edge_slopes_implicit_h5 +use remapping_attic, only : remapping_attic_unit_tests use PCM_functions, only : PCM_reconstruction use PLM_functions, only : PLM_reconstruction, PLM_boundary_extrapolation use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 use MOM_hybgen_remap, only : hybgen_plm_coefs, hybgen_ppm_coefs, hybgen_weno_coefs -use MOM_io, only : stdout, stderr - implicit none ; private !> Container for remapping parameters -type, public :: remapping_CS - private +type, public :: remapping_CS ; private !> Determines which reconstruction to use integer :: remapping_scheme = -911 !> Degree of polynomial reconstruction @@ -76,20 +75,6 @@ module MOM_remapping "PQM_IH6IH5 (5th-order accurate)\n" character(len=3), public :: remappingDefaultScheme = "PLM" !< Default remapping method -! This CPP macro turns on/off bounding of integrations limits so that they are -! always within the cell. Roundoff can lead to the non-dimensional bounds being -! outside of the range 0 to 1. -#define __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - -real, parameter :: hNeglect_dflt = 1.E-30 !< A thickness [H ~> m or kg m-2] that can be - !! added to thicknesses in a denominator without - !! changing the numerical result, except where - !! a division by zero would otherwise occur. - -logical, parameter :: old_algorithm = .false. !< Use the old "broken" algorithm. - !! This is a temporary measure to assist - !! debugging until we delete the old algorithm. - contains !> Set parameters within remapping object @@ -101,7 +86,7 @@ subroutine remapping_set_param(CS, remapping_scheme, boundary_extrapolation, & logical, optional, intent(in) :: check_reconstruction !< Indicate to check reconstructions logical, optional, intent(in) :: check_remapping !< Indicate to check results of remapping logical, optional, intent(in) :: force_bounds_in_subcell !< Force subcells values to be bounded - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + logical, optional, intent(in) :: answers_2018 !< If true use older, less accurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use if (present(remapping_scheme)) then @@ -152,11 +137,12 @@ subroutine extract_member_remapping_CS(CS, remapping_scheme, degree, boundary_ex if (present(force_bounds_in_subcell)) force_bounds_in_subcell = CS%force_bounds_in_subcell end subroutine extract_member_remapping_CS + !> Calculate edge coordinate x from cell width h subroutine buildGridFromH(nz, h, x) integer, intent(in) :: nz !< Number of cells - real, dimension(nz), intent(in) :: h !< Cell widths - real, dimension(nz+1), intent(inout) :: x !< Edge coordiantes starting at x(1)=0 + real, dimension(nz), intent(in) :: h !< Cell widths [H] + real, dimension(nz+1), intent(inout) :: x !< Edge coordinates starting at x(1)=0 [H] ! Local variables integer :: k @@ -167,39 +153,6 @@ subroutine buildGridFromH(nz, h, x) end subroutine buildGridFromH -!> Compare two summation estimates of positive data and judge if due to more -!! than round-off. -!! When two sums are calculated from different vectors that should add up to -!! the same value, the results can differ by round off. The round off error -!! can be bounded to be proportional to the number of operations. -!! This function returns true if the difference between sum1 and sum2 is -!! larger than than the estimated round off bound. -!! \note This estimate/function is only valid for summation of positive data. -function isPosSumErrSignificant(n1, sum1, n2, sum2) - integer, intent(in) :: n1 !< Number of values in sum1 - integer, intent(in) :: n2 !< Number of values in sum2 - real, intent(in) :: sum1 !< Sum of n1 values - real, intent(in) :: sum2 !< Sum of n2 values - logical :: isPosSumErrSignificant !< True if difference in sums is large - ! Local variables - real :: sumErr, allowedErr, eps - - if (sum1<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum1<0 is not allowed!') - if (sum2<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum2<0 is not allowed!') - sumErr = abs(sum1-sum2) - eps = epsilon(sum1) - allowedErr = eps*0.5*(real(n1-1)*sum1+real(n2-1)*sum2) - if (sumErr>allowedErr) then - write(0,*) 'isPosSumErrSignificant: sum1,sum2=',sum1,sum2 - write(0,*) 'isPosSumErrSignificant: eps=',eps - write(0,*) 'isPosSumErrSignificant: err,n*eps=',sumErr,allowedErr - write(0,*) 'isPosSumErrSignificant: err/eps,n1,n2,n1+n2=',sumErr/eps,n1,n2,n1+n2 - isPosSumErrSignificant = .true. - else - isPosSumErrSignificant = .false. - endif -end function isPosSumErrSignificant - !> Remaps column of values u0 on grid h0 to grid h1 assuming the top edge is aligned. subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edge, PCM_cell) type(remapping_CS), intent(in) :: CS !< Remapping control structure @@ -220,9 +173,9 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edg ! Local variables integer :: iMethod - real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial - real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial - real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial + real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial [A] + real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial [A H-1] + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial [A] real :: h0tot, h0err ! Sum of source cell widths and round-off error in this sum [H] real :: h1tot, h1err ! Sum of target cell widths and round-off error in this sum [H] real :: u0tot, u0err ! Integrated values on the source grid and round-off error in this sum [H A] @@ -287,29 +240,33 @@ end subroutine remapping_core_h !> Remaps column of values u0 on grid h0 to implied grid h1 !! where the interfaces of h1 differ from those of h0 by dx. subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_edge ) - type(remapping_CS), intent(in) :: CS !< Remapping control structure - integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid - integer, intent(in) :: n1 !< Number of cells on target grid - real, dimension(n1+1), intent(in) :: dx !< Cell widths on target grid - real, dimension(n1), intent(out) :: u1 !< Cell averages on target grid - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h0. - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width - !! for the purpose of edge value - !! calculations in the same units as h0. + type(remapping_CS), intent(in) :: CS !< Remapping control structure + integer, intent(in) :: n0 !< Number of cells on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] + integer, intent(in) :: n1 !< Number of cells on target grid + real, dimension(n1+1), intent(in) :: dx !< Cell widths on target grid [H] + real, dimension(n1), intent(out) :: u1 !< Cell averages on target grid [A] + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h0 [H]. + real, optional, intent(in) :: h_neglect_edge !< A negligibly small width + !! for the purpose of edge value + !! calculations in the same units as h0 [H]. ! Local variables + real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial [A] + real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial [A H-1] + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial [A] + real :: h0tot, h1tot ! The total thicknesses of the source and target grids [H] + real :: h0err, h1err ! Magnitude of round-off errors in h0tot and h1tot [H] + real :: u0tot, u1tot ! Column integrated values on the source and target grids [H A] + real :: u0err, u1err ! Magnitude of round-off errors in u0tot and u1tot [H A] + real :: u0min, u0max, u1min, u1max ! Extrema of values on the source and target grids [A] + real :: uh_err ! Estimate of bound on error in sum of u*h [A H] + real, dimension(n1) :: h1 !< Cell widths on target grid [H] + real :: hNeglect, hNeglect_edge ! Negligibly small thicknesses [H] integer :: iMethod - real, dimension(n0,2) :: ppoly_r_E !Edge value of polynomial - real, dimension(n0,2) :: ppoly_r_S !Edge slope of polynomial - real, dimension(n0,CS%degree+1) :: ppoly_r_coefs !Coefficients of polynomial integer :: k - real :: h0tot, h0err, h1tot, h1err - real :: u0tot, u0err, u0min, u0max, u1tot, u1err, u1min, u1max, uh_err - real, dimension(n1) :: h1 !< Cell widths on target grid - real :: hNeglect, hNeglect_edge hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect hNeglect_edge = 1.0e-10 ; if (present(h_neglect_edge)) hNeglect_edge = h_neglect_edge @@ -379,19 +336,19 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & h_neglect_edge, PCM_cell ) type(remapping_CS), intent(in) :: CS !< Remapping control structure integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] real, dimension(n0,CS%degree+1), & - intent(out) :: ppoly_r_coefs !< Coefficients of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial + intent(out) :: ppoly_r_coefs !< Coefficients of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial [A H-1] integer, intent(out) :: iMethod !< Integration method real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions - !! in the same units as h0. + !! in the same units as h0 [H] real, optional, intent(in) :: h_neglect_edge !< A negligibly small width !! for the purpose of edge value - !! calculations in the same units as h0. + !! calculations in the same units as h0 [H] logical, optional, intent(in) :: PCM_cell(n0) !< If present, use PCM remapping for !! cells from the source grid where this is true. @@ -500,17 +457,17 @@ end subroutine build_reconstructions_1d subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & ppoly_r_coefs, ppoly_r_E, ppoly_r_S) integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] integer, intent(in) :: deg !< Degree of polynomial reconstruction logical, intent(in) :: boundary_extrapolation !< Extrapolate at boundaries if true - real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefs !< Coefficients of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial + real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefs !< Coefficients of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial [A H-1] ! Local variables integer :: i0, n - real :: u_l, u_c, u_r ! Cell averages - real :: u_min, u_max + real :: u_l, u_c, u_r ! Cell averages [A] + real :: u_min, u_max ! Cell extrema [A] logical :: problem_detected problem_detected = .false. @@ -573,18 +530,18 @@ end subroutine check_reconstructions_1d !! appropriate integrals into the h1*u1 values. h0 and h1 must have the same units. subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, method, & force_bounds_in_subcell, u1, uh_err, ah_sub, aisub_src, aiss, aise ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: h0(n0) !< Source grid widths (size n0) - real, intent(in) :: u0(n0) !< Source cell averages (size n0) - real, intent(in) :: ppoly0_E(n0,2) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, intent(in) :: h1(n1) !< Target grid widths (size n1) - integer, intent(in) :: method !< Remapping scheme to use + integer, intent(in) :: n0 !< Number of cells in source grid + real, intent(in) :: h0(n0) !< Source grid widths (size n0) [H] + real, intent(in) :: u0(n0) !< Source cell averages (size n0) [A] + real, intent(in) :: ppoly0_E(n0,2) !< Edge value of polynomial [A] + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial [A] + integer, intent(in) :: n1 !< Number of cells in target grid + real, intent(in) :: h1(n1) !< Target grid widths (size n1) [H] + integer, intent(in) :: method !< Remapping scheme to use logical, intent(in) :: force_bounds_in_subcell !< Force sub-cell values to be bounded - real, intent(out) :: u1(n1) !< Target cell averages (size n1) - real, intent(out) :: uh_err !< Estimate of bound on error in sum of u*h - real, optional, intent(out) :: ah_sub(n0+n1+1) !< h_sub + real, intent(out) :: u1(n1) !< Target cell averages (size n1) [A] + real, intent(out) :: uh_err !< Estimate of bound on error in sum of u*h [A H] + real, optional, intent(out) :: ah_sub(n0+n1+1) !< Overlapping sub-cell thicknesses, h_sub [H] integer, optional, intent(out) :: aisub_src(n0+n1+1) !< i_sub_src integer, optional, intent(out) :: aiss(n0) !< isrc_start integer, optional, intent(out) :: aise(n0) !< isrc_ens @@ -595,36 +552,38 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth integer :: i_start0 ! Used to record which sub-cells map to source cells integer :: i_start1 ! Used to record which sub-cells map to target cells integer :: i_max ! Used to record which sub-cell is the largest contribution of a source cell - real :: dh_max ! Used to record which sub-cell is the largest contribution of a source cell - real, dimension(n0+n1+1) :: h_sub ! Width of each each sub-cell - real, dimension(n0+n1+1) :: uh_sub ! Integral of u*h over each sub-cell - real, dimension(n0+n1+1) :: u_sub ! Average of u over each sub-cell + real :: dh_max ! Used to record which sub-cell is the largest contribution of a source cell [H] + real, dimension(n0+n1+1) :: h_sub ! Width of each each sub-cell [H] + real, dimension(n0+n1+1) :: uh_sub ! Integral of u*h over each sub-cell [A H] + real, dimension(n0+n1+1) :: u_sub ! Average of u over each sub-cell [A] integer, dimension(n0+n1+1) :: isub_src ! Index of source cell for each sub-cell integer, dimension(n0) :: isrc_start ! Index of first sub-cell within each source cell integer, dimension(n0) :: isrc_end ! Index of last sub-cell within each source cell integer, dimension(n0) :: isrc_max ! Index of thickest sub-cell within each source cell - real, dimension(n0) :: h0_eff ! Effective thickness of source cells - real, dimension(n0) :: u0_min ! Minimum value of reconstructions in source cell - real, dimension(n0) :: u0_max ! Minimum value of reconstructions in source cell + real, dimension(n0) :: h0_eff ! Effective thickness of source cells [H] + real, dimension(n0) :: u0_min ! Minimum value of reconstructions in source cell [A] + real, dimension(n0) :: u0_max ! Minimum value of reconstructions in source cell [A] integer, dimension(n1) :: itgt_start ! Index of first sub-cell within each target cell integer, dimension(n1) :: itgt_end ! Index of last sub-cell within each target cell - real :: xa, xb ! Non-dimensional position within a source cell (0..1) - real :: h0_supply, h1_supply ! The amount of width available for constructing sub-cells - real :: dh ! The width of the sub-cell - real :: duh ! The total amount of accumulated stuff (u*h) - real :: dh0_eff ! Running sum of source cell thickness + real :: xa, xb ! Non-dimensional position within a source cell (0..1) [nondim] + real :: h0_supply, h1_supply ! The amount of width available for constructing sub-cells [H] + real :: dh ! The width of the sub-cell [H] + real :: duh ! The total amount of accumulated stuff (u*h) [A H] + real :: dh0_eff ! Running sum of source cell thickness [H] ! For error checking/debugging logical, parameter :: force_bounds_in_target = .true. ! To fix round-off issues logical, parameter :: adjust_thickest_subcell = .true. ! To fix round-off conservation issues logical, parameter :: debug_bounds = .false. ! For debugging overshoots etc. integer :: k, i0_last_thick_cell - real :: h0tot, h0err, h1tot, h1err, h2tot, h2err, u02_err - real :: u0tot, u0err, u0min, u0max, u1tot, u1err, u1min, u1max, u2tot, u2err, u2min, u2max, u_orig + real :: h0tot, h1tot, h2tot ! Summed thicknesses used for debugging [H] + real :: h0err, h1err, h2err ! Estimates of round-off errors used for debugging [H] + real :: u02_err, u0err, u1err, u2err ! Integrated reconstruction error estimates [H A] + real :: u0tot, u1tot, u2tot ! Integrated reconstruction values [H A] + real :: u_orig ! The original value of the reconstruction in a cell [A] + real :: u0min, u0max, u1min, u1max, u2min, u2max ! Minimum and maximum values of reconstructions [A] logical :: src_has_volume !< True if h0 has not been consumed logical :: tgt_has_volume !< True if h1 has not been consumed - if (old_algorithm) isrc_max(:)=1 - i0_last_thick_cell = 0 do i0 = 1, n0 u0_min(i0) = min(ppoly0_E(i0,1), ppoly0_E(i0,2)) @@ -692,28 +651,13 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth ! Record the source cell thickness found by summing the sub-cell thicknesses. h0_eff(i0) = dh0_eff ! Move the source index. - if (old_algorithm) then - if (i0 < i0_last_thick_cell) then - i0 = i0 + 1 - h0_supply = h0(i0) - dh0_eff = 0. - do while (h0_supply==0. .and. i0= h1_supply .and. tgt_has_volume) then ! h1_supply is smaller than h0_supply) so we consume h1_supply and increment the @@ -729,12 +673,8 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth i1 = i1 + 1 h1_supply = h1(i1) else - if (old_algorithm) then - h1_supply = 1.E30 - else - h1_supply = 0. - tgt_has_volume = .false. - endif + h1_supply = 0. + tgt_has_volume = .false. endif elseif (src_has_volume) then ! We ran out of target volume but still have source cells to consume @@ -984,18 +924,21 @@ end subroutine remap_via_sub_cells !! separation dh. real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefs, method, i0, xa, xb) integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: u0(:) !< Cell means - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial + real, intent(in) :: u0(:) !< Cell means [A] + real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial [A] + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial [A] integer, intent(in) :: method !< Remapping scheme to use integer, intent(in) :: i0 !< Source cell index - real, intent(in) :: xa !< Non-dimensional start position within source cell - real, intent(in) :: xb !< Non-dimensional end position within source cell + real, intent(in) :: xa !< Non-dimensional start position within source cell [nondim] + real, intent(in) :: xb !< Non-dimensional end position within source cell [nondim] ! Local variables - real :: u_ave, xa_2, xb_2, xa2pxb2, xapxb - real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials - - real :: mx, a_L, a_R, u_c, Ya, Yb, my, xa2b2ab, Ya2b2ab, a_c + real :: u_ave ! The average value of the polynomial over the specified range [A] + real :: xapxb ! A sum of fracional positions [nondim] + real :: mx, Ya, Yb, my ! Various fractional positions [nondim] + real :: xa_2, xb_2 ! Squared fractional positions [nondim] + real :: xa2pxb2, xa2b2ab, Ya2b2ab ! Sums of squared fractional positions [nondim] + real :: a_L, a_R, u_c, a_c ! Values of the polynomial at various locations [A] + real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials [nondim] if (xb > xa) then select case ( method ) @@ -1085,18 +1028,18 @@ end function average_value_ppoly !> Measure totals and bounds on source grid subroutine measure_input_bounds( n0, h0, u0, edge_values, h0tot, h0err, u0tot, u0err, u0min, u0max ) integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid - real, dimension(n0,2), intent(in) :: edge_values !< Cell edge values on source grid - real, intent(out) :: h0tot !< Sum of cell widths - real, intent(out) :: h0err !< Magnitude of round-off error in h0tot - real, intent(out) :: u0tot !< Sum of cell widths times values - real, intent(out) :: u0err !< Magnitude of round-off error in u0tot - real, intent(out) :: u0min !< Minimum value in reconstructions of u0 - real, intent(out) :: u0max !< Maximum value in reconstructions of u0 + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] + real, dimension(n0,2), intent(in) :: edge_values !< Cell edge values on source grid [A] + real, intent(out) :: h0tot !< Sum of cell widths [H] + real, intent(out) :: h0err !< Magnitude of round-off error in h0tot [H] + real, intent(out) :: u0tot !< Sum of cell widths times values [H A] + real, intent(out) :: u0err !< Magnitude of round-off error in u0tot [H A] + real, intent(out) :: u0min !< Minimum value in reconstructions of u0 [A] + real, intent(out) :: u0max !< Maximum value in reconstructions of u0 [A] ! Local variables + real :: eps ! The smallest representable fraction of a number [nondim] integer :: k - real :: eps eps = epsilon(h0(1)) h0tot = h0(1) @@ -1119,17 +1062,17 @@ end subroutine measure_input_bounds !> Measure totals and bounds on destination grid subroutine measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) integer, intent(in) :: n1 !< Number of cells on destination grid - real, dimension(n1), intent(in) :: h1 !< Cell widths on destination grid - real, dimension(n1), intent(in) :: u1 !< Cell averages on destination grid - real, intent(out) :: h1tot !< Sum of cell widths - real, intent(out) :: h1err !< Magnitude of round-off error in h1tot - real, intent(out) :: u1tot !< Sum of cell widths times values - real, intent(out) :: u1err !< Magnitude of round-off error in u1tot - real, intent(out) :: u1min !< Minimum value in reconstructions of u1 - real, intent(out) :: u1max !< Maximum value in reconstructions of u1 + real, dimension(n1), intent(in) :: h1 !< Cell widths on destination grid [H] + real, dimension(n1), intent(in) :: u1 !< Cell averages on destination grid [A] + real, intent(out) :: h1tot !< Sum of cell widths [H] + real, intent(out) :: h1err !< Magnitude of round-off error in h1tot [H] + real, intent(out) :: u1tot !< Sum of cell widths times values [H A] + real, intent(out) :: u1err !< Magnitude of round-off error in u1tot [H A] + real, intent(out) :: u1min !< Minimum value in reconstructions of u1 [A] + real, intent(out) :: u1max !< Maximum value in reconstructions of u1 [A] ! Local variables + real :: eps ! The smallest representable fraction of a number [nondim] integer :: k - real :: eps eps = epsilon(h1(1)) h1tot = h1(1) @@ -1149,444 +1092,16 @@ subroutine measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, end subroutine measure_output_bounds -!> Remaps column of values u0 on grid h0 to grid h1 by integrating -!! over the projection of each h1 cell onto the h0 grid. -subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n1, h1, method, u1, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: h0(:) !< Source grid widths (size n0) - real, intent(in) :: u0(:) !< Source cell averages (size n0) - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, intent(in) :: h1(:) !< Target grid widths (size n1) - integer, intent(in) :: method !< Remapping scheme to use - real, intent(out) :: u1(:) !< Target cell averages (size n1) - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h. - ! Local variables - integer :: iTarget - real :: xL, xR ! coordinates of target cell edges - integer :: jStart ! Used by integrateReconOnInterval() - real :: xStart ! Used by integrateReconOnInterval() - - ! Loop on cells in target grid (grid1). For each target cell, we need to find - ! in which source cells the target cell edges lie. The associated indexes are - ! noted j0 and j1. - xR = 0. ! Left boundary is at x=0 - jStart = 1 - xStart = 0. - do iTarget = 1,n1 - ! Determine the coordinates of the target cell edges - xL = xR - xR = xL + h1(iTarget) - - call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & - xL, xR, h1(iTarget), u1(iTarget), jStart, xStart, h_neglect ) - - enddo ! end iTarget loop on target grid cells - -end subroutine remapByProjection - - -!> Remaps column of values u0 on grid h0 to implied grid h1 -!! where the interfaces of h1 differ from those of h0 by dx. -!! The new grid is defined relative to the original grid by change -!! dx1(:) = xNew(:) - xOld(:) -!! and the remapping calculated so that -!! hNew(k) qNew(k) = hOld(k) qOld(k) + F(k+1) - F(k) -!! where -!! F(k) = dx1(k) qAverage -!! and where qAverage is the average qOld in the region zOld(k) to zNew(k). -subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, dx1, & - method, u1, h1, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) - real, dimension(:), intent(in) :: u0 !< Source cell averages (size n0) - real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial - real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, dimension(:), intent(in) :: dx1 !< Target grid edge positions (size n1+1) - integer, intent(in) :: method !< Remapping scheme to use - real, dimension(:), intent(out) :: u1 !< Target cell averages (size n1) - real, dimension(:), & - optional, intent(out) :: h1 !< Target grid widths (size n1) - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h. - ! Local variables - integer :: iTarget - real :: xL, xR ! coordinates of target cell edges - real :: xOld, hOld, uOld - real :: xNew, hNew, h_err - real :: uhNew, hFlux, uAve, fluxL, fluxR - integer :: jStart ! Used by integrateReconOnInterval() - real :: xStart ! Used by integrateReconOnInterval() - - ! Loop on cells in target grid. For each cell, iTarget, the left flux is - ! the right flux of the cell to the left, iTarget-1. - ! The left flux is initialized by started at iTarget=0 to calculate the - ! right flux which can take into account the target left boundary being - ! in the interior of the source domain. - fluxR = 0. - h_err = 0. ! For measuring round-off error - jStart = 1 - xStart = 0. - do iTarget = 0,n1 - fluxL = fluxR ! This does nothing for iTarget=0 - - if (iTarget == 0) then - xOld = 0. ! Left boundary is at x=0 - hOld = -1.E30 ! Should not be used for iTarget = 0 - uOld = -1.E30 ! Should not be used for iTarget = 0 - elseif (iTarget <= n0) then - xOld = xOld + h0(iTarget) ! Position of right edge of cell - hOld = h0(iTarget) - uOld = u0(iTarget) - h_err = h_err + epsilon(hOld) * max(hOld, xOld) - else - hOld = 0. ! as if for layers>n0, they were vanished - uOld = 1.E30 ! and the initial value should not matter - endif - xNew = xOld + dx1(iTarget+1) - xL = min( xOld, xNew ) - xR = max( xOld, xNew ) - - ! hFlux is the positive width of the remapped volume - hFlux = abs(dx1(iTarget+1)) - call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & - xL, xR, hFlux, uAve, jStart, xStart ) - ! uAve is the average value of u, independent of sign of dx1 - fluxR = dx1(iTarget+1)*uAve ! Includes sign of dx1 - - if (iTarget>0) then - hNew = hOld + ( dx1(iTarget+1) - dx1(iTarget) ) - hNew = max( 0., hNew ) - uhNew = ( uOld * hOld ) + ( fluxR - fluxL ) - if (hNew>0.) then - u1(iTarget) = uhNew / hNew - else - u1(iTarget) = uAve - endif - if (present(h1)) h1(iTarget) = hNew - endif - - enddo ! end iTarget loop on target grid cells - -end subroutine remapByDeltaZ - - -!> Integrate the reconstructed column profile over a single cell -subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & - xL, xR, hC, uAve, jStart, xStart, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) - real, dimension(:), intent(in) :: u0 !< Source cell averages - real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial - real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial - integer, intent(in) :: method !< Remapping scheme to use - real, intent(in) :: xL !< Left edges of target cell - real, intent(in) :: xR !< Right edges of target cell - real, intent(in) :: hC !< Cell width hC = xR - xL - real, intent(out) :: uAve !< Average value on target cell - integer, intent(inout) :: jStart !< The index of the cell to start searching from - !< On exit, contains index of last cell used - real, intent(inout) :: xStart !< The left edge position of cell jStart - !< On first entry should be 0. - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h. - ! Local variables - integer :: j, k - integer :: jL, jR ! indexes of source cells containing target - ! cell edges - real :: q ! complete integration - real :: xi0, xi1 ! interval of integration (local -- normalized - ! -- coordinates) - real :: x0jLl, x0jLr ! Left/right position of cell jL - real :: x0jRl, x0jRr ! Left/right position of cell jR - real :: hAct ! The distance actually used in the integration - ! (notionally xR - xL) which differs due to roundoff. - real :: x0_2, x1_2, x02px12, x0px1 ! Used in evaluation of integrated polynomials - real :: hNeglect ! A negligible thicness in the same units as h. - real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials - - hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect - - q = -1.E30 - x0jLl = -1.E30 - x0jRl = -1.E30 - - ! Find the left most cell in source grid spanned by the target cell - jL = -1 - x0jLr = xStart - do j = jStart, n0 - x0jLl = x0jLr - x0jLr = x0jLl + h0(j) - ! Left edge is found in cell j - if ( ( xL >= x0jLl ) .AND. ( xL <= x0jLr ) ) then - jL = j - exit ! once target grid cell is found, exit loop - endif - enddo - jStart = jL - xStart = x0jLl - -! ! HACK to handle round-off problems. Need only at j=n0. -! ! This moves the effective cell boundary outwards a smidgen. -! if (xL>x0jLr) x0jLr = xL - - ! If, at this point, jL is equal to -1, it means the vanished - ! cell lies outside the source grid. In other words, it means that - ! the source and target grids do not cover the same physical domain - ! and there is something very wrong ! - if ( jL == -1 ) call MOM_error(FATAL, & - 'MOM_remapping, integrateReconOnInterval: '//& - 'The location of the left-most cell could not be found') - - - ! ============================================================ - ! Check whether target cell is vanished. If it is, the cell - ! average is simply the interpolated value at the location - ! of the vanished cell. If it isn't, we need to integrate the - ! quantity within the cell and divide by the cell width to - ! determine the cell average. - ! ============================================================ - ! 1. Cell is vanished - !if ( abs(xR - xL) <= epsilon(xR)*max(abs(xR),abs(xL)) ) then - if ( abs(xR - xL) == 0.0 ) then - - ! We check whether the source cell (i.e. the cell in which the - ! vanished target cell lies) is vanished. If it is, the interpolated - ! value is set to be mean of the edge values (which should be the same). - ! If it isn't, we simply interpolate. - if ( h0(jL) == 0.0 ) then - uAve = 0.5 * ( ppoly0_E(jL,1) + ppoly0_E(jL,2) ) - else - ! WHY IS THIS NOT WRITTEN AS xi0 = ( xL - x0jLl ) / h0(jL) ---AJA - xi0 = xL / ( h0(jL) + hNeglect ) - x0jLl / ( h0(jL) + hNeglect ) - - select case ( method ) - case ( INTEGRATION_PCM ) - uAve = ppoly0_coefs(jL,1) - case ( INTEGRATION_PLM ) - uAve = ppoly0_coefs(jL,1) & - + xi0 * ppoly0_coefs(jL,2) - case ( INTEGRATION_PPM ) - uAve = ppoly0_coefs(jL,1) & - + xi0 * ( ppoly0_coefs(jL,2) & - + xi0 * ppoly0_coefs(jL,3) ) - case ( INTEGRATION_PQM ) - uAve = ppoly0_coefs(jL,1) & - + xi0 * ( ppoly0_coefs(jL,2) & - + xi0 * ( ppoly0_coefs(jL,3) & - + xi0 * ( ppoly0_coefs(jL,4) & - + xi0 * ppoly0_coefs(jL,5) ) ) ) - case default - call MOM_error( FATAL,'The selected integration method is invalid' ) - end select - - endif ! end checking whether source cell is vanished - - ! 2. Cell is not vanished - else - - ! Find the right most cell in source grid spanned by the target cell - jR = -1 - x0jRr = xStart - do j = jStart,n0 - x0jRl = x0jRr - x0jRr = x0jRl + h0(j) - ! Right edge is found in cell j - if ( ( xR >= x0jRl ) .AND. ( xR <= x0jRr ) ) then - jR = j - exit ! once target grid cell is found, exit loop - endif - enddo ! end loop on source grid cells - - ! If xR>x0jRr then the previous loop reached j=n0 and the target - ! position, xR, was beyond the right edge of the source grid (h0). - ! This can happen due to roundoff, in which case we set jR=n0. - if (xR>x0jRr) jR = n0 - - ! To integrate, two cases must be considered: (1) the target cell is - ! entirely contained within a cell of the source grid and (2) the target - ! cell spans at least two cells of the source grid. - - if ( jL == jR ) then - ! The target cell is entirely contained within a cell of the source - ! grid. This situation is represented by the following schematic, where - ! the cell in which xL and xR are located has index jL=jR : - ! - ! ----|-----o--------o----------|------------- - ! xL xR - ! - ! Determine normalized coordinates -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) - xi1 = max( 0., min( 1., ( xR - x0jLl ) / ( h0(jL) + hNeglect ) ) ) -#else - xi0 = xL / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) - xi1 = xR / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) -#endif - - hAct = h0(jL) * ( xi1 - xi0 ) - - ! Depending on which polynomial is used, integrate quantity - ! between xi0 and xi1. Integration is carried out in normalized - ! coordinates, hence: \int_xL^xR p(x) dx = h \int_xi0^xi1 p(xi) dxi - select case ( method ) - case ( INTEGRATION_PCM ) - q = ( xR - xL ) * ppoly0_coefs(jL,1) - case ( INTEGRATION_PLM ) - q = ( xR - xL ) * ( & - ppoly0_coefs(jL,1) & - + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) - case ( INTEGRATION_PPM ) - q = ( xR - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) - case ( INTEGRATION_PQM ) - x0_2 = xi0*xi0 - x1_2 = xi1*xi1 - x02px12 = x0_2 + x1_2 - x0px1 = xi1 + xi0 - q = ( xR - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) - case default - call MOM_error( FATAL,'The selected integration method is invalid' ) - end select - - else - ! The target cell spans at least two cells of the source grid. - ! This situation is represented by the following schematic, where - ! the cells in which xL and xR are located have indexes jL and jR, - ! respectively : - ! - ! ----|-----o---|--- ... --|---o----------|------------- - ! xL xR - ! - ! We first integrate from xL up to the right boundary of cell jL, then - ! add the integrated amounts of cells located between jL and jR and then - ! integrate from the left boundary of cell jR up to xR - - q = 0.0 - - ! Integrate from xL up to right boundary of cell jL -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) -#else - xi0 = (xL - x0jLl) / ( h0(jL) + hNeglect ) -#endif - xi1 = 1.0 - - hAct = h0(jL) * ( xi1 - xi0 ) - - select case ( method ) - case ( INTEGRATION_PCM ) - q = q + ( x0jLr - xL ) * ppoly0_coefs(jL,1) - case ( INTEGRATION_PLM ) - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefs(jL,1) & - + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) - case ( INTEGRATION_PPM ) - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) - case ( INTEGRATION_PQM ) - x0_2 = xi0*xi0 - x1_2 = xi1*xi1 - x02px12 = x0_2 + x1_2 - x0px1 = xi1 + xi0 - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) - case default - call MOM_error( FATAL, 'The selected integration method is invalid' ) - end select - - ! Integrate contents within cells strictly comprised between jL and jR - if ( jR > (jL+1) ) then - do k = jL+1,jR-1 - q = q + h0(k) * u0(k) - hAct = hAct + h0(k) - enddo - endif - - ! Integrate from left boundary of cell jR up to xR - xi0 = 0.0 -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - xi1 = max( 0., min( 1., ( xR - x0jRl ) / ( h0(jR) + hNeglect ) ) ) -#else - xi1 = (xR - x0jRl) / ( h0(jR) + hNeglect ) -#endif - - hAct = hAct + h0(jR) * ( xi1 - xi0 ) - - select case ( method ) - case ( INTEGRATION_PCM ) - q = q + ( xR - x0jRl ) * ppoly0_coefs(jR,1) - case ( INTEGRATION_PLM ) - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefs(jR,1) & - + ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) ) - case ( INTEGRATION_PPM ) - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefs(jR,1) & - + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefs(jR,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) - case ( INTEGRATION_PQM ) - x0_2 = xi0*xi0 - x1_2 = xi1*xi1 - x02px12 = x0_2 + x1_2 - x0px1 = xi1 + xi0 - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefs(jR,1) & - + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefs(jR,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefs(jR,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefs(jR,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) - case default - call MOM_error( FATAL,'The selected integration method is invalid' ) - end select - - endif ! end integration for non-vanished cells - - ! The cell average is the integrated value divided by the cell width -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ -if (hAct==0.) then - uAve = ppoly0_coefs(jL,1) -else - uAve = q / hAct -endif -#else - uAve = q / hC -#endif - - endif ! endif clause to check if cell is vanished - -end subroutine integrateReconOnInterval - !> Calculates the change in interface positions based on h1 and h2 subroutine dzFromH1H2( n1, h1, n2, h2, dx ) integer, intent(in) :: n1 !< Number of cells on source grid - real, dimension(:), intent(in) :: h1 !< Cell widths of source grid (size n1) + real, dimension(:), intent(in) :: h1 !< Cell widths of source grid (size n1) [H] integer, intent(in) :: n2 !< Number of cells on target grid - real, dimension(:), intent(in) :: h2 !< Cell widths of target grid (size n2) - real, dimension(:), intent(out) :: dx !< Change in interface position (size n2+1) + real, dimension(:), intent(in) :: h2 !< Cell widths of target grid (size n2) [H] + real, dimension(:), intent(out) :: dx !< Change in interface position (size n2+1) [H] ! Local variables integer :: k - real :: x1, x2 + real :: x1, x2 ! Interface positions [H] x1 = 0. x2 = 0. @@ -1611,7 +1126,7 @@ subroutine initialize_remapping( CS, remapping_scheme, boundary_extrapolation, & logical, optional, intent(in) :: check_reconstruction !< Indicate to check reconstructions logical, optional, intent(in) :: check_remapping !< Indicate to check results of remapping logical, optional, intent(in) :: force_bounds_in_subcell !< Force subcells values to be bounded - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + logical, optional, intent(in) :: answers_2018 !< If true use older, less accurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Note that remapping_scheme is mandatory for initialize_remapping() @@ -1684,8 +1199,8 @@ logical function remapping_unit_tests(verbose) ! Local variables integer, parameter :: n0 = 4, n1 = 3, n2 = 6 real :: h0(n0), x0(n0+1), u0(n0) - real :: h1(n1), x1(n1+1), u1(n1), hn1(n1), dx1(n1+1) - real :: h2(n2), x2(n2+1), u2(n2), hn2(n2), dx2(n2+1) + real :: h1(n1), x1(n1+1), u1(n1), dx1(n1+1) + real :: h2(n2), x2(n2+1), u2(n2) data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 data h1 /3*1./ ! 3 uniform layers with total depth of 3 @@ -1694,6 +1209,10 @@ logical function remapping_unit_tests(verbose) real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs integer :: answer_date ! The vintage of the expressions to test integer :: i + real, parameter :: hNeglect_dflt = 1.0e-30 ! A thickness [H ~> m or kg m-2] that can be + ! added to thicknesses in a denominator without + ! changing the numerical result, except where + ! a division by zero would otherwise occur. real :: err, h_neglect, h_neglect_edge logical :: thisTest, v @@ -1749,49 +1268,9 @@ logical function remapping_unit_tests(verbose) call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10, answer_date=answer_date ) call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=answer_date ) call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) - u1(:) = 0. - call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n1, h1, INTEGRATION_PPM, u1, h_neglect ) - do i=1,n1 - err=u1(i)-8.*(0.5*real(1+n1)-real(i)) - if (abs(err)>2.*epsilon(err)) thisTest = .true. - enddo - if (thisTest) write(stdout,*) 'remapping_unit_tests: Failed remapByProjection()' - remapping_unit_tests = remapping_unit_tests .or. thisTest - - thisTest = .false. - u1(:) = 0. - call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n1, x1-x0(1:n1+1), & - INTEGRATION_PPM, u1, hn1, h_neglect ) - if (verbose) write(stdout,*) 'h1 (by delta)' - if (verbose) call dumpGrid(n1,h1,x1,u1) - hn1=hn1-h1 - do i=1,n1 - err=u1(i)-8.*(0.5*real(1+n1)-real(i)) - if (abs(err)>2.*epsilon(err)) thisTest = .true. - enddo - if (thisTest) write(stdout,*) 'remapping_unit_tests: Failed remapByDeltaZ() 1' - remapping_unit_tests = remapping_unit_tests .or. thisTest thisTest = .false. call buildGridFromH(n2, h2, x2) - dx2(1:n0+1) = x2(1:n0+1) - x0 - dx2(n0+2:n2+1) = x2(n0+2:n2+1) - x0(n0+1) - call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n2, dx2, & - INTEGRATION_PPM, u2, hn2, h_neglect ) - if (verbose) write(stdout,*) 'h2' - if (verbose) call dumpGrid(n2,h2,x2,u2) - if (verbose) write(stdout,*) 'hn2' - if (verbose) call dumpGrid(n2,hn2,x2,u2) - - do i=1,n2 - err=u2(i)-8./2.*(0.5*real(1+n2)-real(i)) - if (abs(err)>2.*epsilon(err)) thisTest = .true. - enddo - if (thisTest) write(stdout,*) 'remapping_unit_tests: Failed remapByDeltaZ() 2' - remapping_unit_tests = remapping_unit_tests .or. thisTest if (verbose) write(stdout,*) 'Via sub-cells' thisTest = .false. @@ -1945,6 +1424,9 @@ logical function remapping_unit_tests(verbose) deallocate(ppoly0_E, ppoly0_S, ppoly0_coefs) + ! This line carries out tests on some older remapping schemes. + remapping_unit_tests = remapping_unit_tests .or. remapping_attic_unit_tests(verbose) + if (.not. remapping_unit_tests) write(stdout,*) 'Pass' end function remapping_unit_tests @@ -1953,12 +1435,12 @@ end function remapping_unit_tests logical function test_answer(verbose, n, u, u_true, label, tol) logical, intent(in) :: verbose !< If true, write results to stdout integer, intent(in) :: n !< Number of cells in u - real, dimension(n), intent(in) :: u !< Values to test - real, dimension(n), intent(in) :: u_true !< Values to test against (correct answer) + real, dimension(n), intent(in) :: u !< Values to test [A] + real, dimension(n), intent(in) :: u_true !< Values to test against (correct answer) [A] character(len=*), intent(in) :: label !< Message - real, optional, intent(in) :: tol !< The tolerance for differences between u and u_true + real, optional, intent(in) :: tol !< The tolerance for differences between u and u_true [A] ! Local variables - real :: tolerance ! The tolerance for differences between u and u_true + real :: tolerance ! The tolerance for differences between u and u_true [A] integer :: k tolerance = 0.0 ; if (present(tol)) tolerance = tol @@ -1983,9 +1465,9 @@ end function test_answer !> Convenience function for printing grid to screen subroutine dumpGrid(n,h,x,u) integer, intent(in) :: n !< Number of cells - real, dimension(:), intent(in) :: h !< Cell thickness - real, dimension(:), intent(in) :: x !< Interface delta - real, dimension(:), intent(in) :: u !< Cell average values + real, dimension(:), intent(in) :: h !< Cell thickness [H] + real, dimension(:), intent(in) :: x !< Interface delta [H] + real, dimension(:), intent(in) :: u !< Cell average values [A] integer :: i write(stdout,'("i=",20i10)') (i,i=1,n+1) write(stdout,'("x=",20es10.2)') (x(i),i=1,n+1) diff --git a/src/ALE/remapping_attic.F90 b/src/ALE/remapping_attic.F90 new file mode 100644 index 0000000000..534428aaed --- /dev/null +++ b/src/ALE/remapping_attic.F90 @@ -0,0 +1,648 @@ +!> Retains older versions of column-wise vertical remapping functions that are +!! no longer used in MOM6, but may be useful later for documenting the development +!! of the schemes that are used in MOM6. +module remapping_attic + +! This file is part of MOM6. See LICENSE.md for the license. +! Original module written by Laurent White, 2008.06.09 + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_io, only : stdout +use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use regrid_edge_values, only : edge_values_explicit_h4 + +implicit none ; private + +! The following routines are visible to the outside world +public remapping_attic_unit_tests, remapByProjection, remapByDeltaZ +public isPosSumErrSignificant + +! The following are private parameter constants +integer, parameter :: INTEGRATION_PCM = 0 !< Piecewise Constant Method +integer, parameter :: INTEGRATION_PLM = 1 !< Piecewise Linear Method +integer, parameter :: INTEGRATION_PPM = 3 !< Piecewise Parabolic Method +integer, parameter :: INTEGRATION_PQM = 5 !< Piecewise Quartic Method + +! This CPP macro turns on/off bounding of integrations limits so that they are +! always within the cell. Roundoff can lead to the non-dimensional bounds being +! outside of the range 0 to 1. +#define __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + +real, parameter :: hNeglect_dflt = 1.E-30 !< A thickness [H ~> m or kg m-2] that can be + !! added to thicknesses in a denominator without + !! changing the numerical result, except where + !! a division by zero would otherwise occur. + +contains + +!> Compare two summation estimates of positive data and judge if due to more +!! than round-off. +!! When two sums are calculated from different vectors that should add up to +!! the same value, the results can differ by round off. The round off error +!! can be bounded to be proportional to the number of operations. +!! This function returns true if the difference between sum1 and sum2 is +!! larger than than the estimated round off bound. +!! \note This estimate/function is only valid for summation of positive data. +function isPosSumErrSignificant(n1, sum1, n2, sum2) + integer, intent(in) :: n1 !< Number of values in sum1 + integer, intent(in) :: n2 !< Number of values in sum2 + real, intent(in) :: sum1 !< Sum of n1 values [A] + real, intent(in) :: sum2 !< Sum of n2 values [A] + logical :: isPosSumErrSignificant !< True if difference in sums is large + ! Local variables + real :: sumErr, allowedErr, eps + + if (sum1<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum1<0 is not allowed!') + if (sum2<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum2<0 is not allowed!') + sumErr = abs(sum1-sum2) + eps = epsilon(sum1) + allowedErr = eps*0.5*(real(n1-1)*sum1+real(n2-1)*sum2) + if (sumErr>allowedErr) then + write(0,*) 'isPosSumErrSignificant: sum1,sum2=',sum1,sum2 + write(0,*) 'isPosSumErrSignificant: eps=',eps + write(0,*) 'isPosSumErrSignificant: err,n*eps=',sumErr,allowedErr + write(0,*) 'isPosSumErrSignificant: err/eps,n1,n2,n1+n2=',sumErr/eps,n1,n2,n1+n2 + isPosSumErrSignificant = .true. + else + isPosSumErrSignificant = .false. + endif +end function isPosSumErrSignificant + +!> Remaps column of values u0 on grid h0 to grid h1 by integrating +!! over the projection of each h1 cell onto the h0 grid. +subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n1, h1, method, u1, h_neglect ) + integer, intent(in) :: n0 !< Number of cells in source grid + real, intent(in) :: h0(:) !< Source grid widths (size n0) + real, intent(in) :: u0(:) !< Source cell averages (size n0) + real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial + integer, intent(in) :: n1 !< Number of cells in target grid + real, intent(in) :: h1(:) !< Target grid widths (size n1) + integer, intent(in) :: method !< Remapping scheme to use + real, intent(out) :: u1(:) !< Target cell averages (size n1) + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h. + ! Local variables + integer :: iTarget + real :: xL, xR ! coordinates of target cell edges + integer :: jStart ! Used by integrateReconOnInterval() + real :: xStart ! Used by integrateReconOnInterval() + + ! Loop on cells in target grid (grid1). For each target cell, we need to find + ! in which source cells the target cell edges lie. The associated indexes are + ! noted j0 and j1. + xR = 0. ! Left boundary is at x=0 + jStart = 1 + xStart = 0. + do iTarget = 1,n1 + ! Determine the coordinates of the target cell edges + xL = xR + xR = xL + h1(iTarget) + + call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & + xL, xR, h1(iTarget), u1(iTarget), jStart, xStart, h_neglect ) + + enddo ! end iTarget loop on target grid cells + +end subroutine remapByProjection + +!> Remaps column of values u0 on grid h0 to implied grid h1 +!! where the interfaces of h1 differ from those of h0 by dx. +!! The new grid is defined relative to the original grid by change +!! dx1(:) = xNew(:) - xOld(:) +!! and the remapping calculated so that +!! hNew(k) qNew(k) = hOld(k) qOld(k) + F(k+1) - F(k) +!! where +!! F(k) = dx1(k) qAverage +!! and where qAverage is the average qOld in the region zOld(k) to zNew(k). +subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, dx1, & + method, u1, h1, h_neglect ) + integer, intent(in) :: n0 !< Number of cells in source grid + real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) + real, dimension(:), intent(in) :: u0 !< Source cell averages (size n0) + real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial + real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial + integer, intent(in) :: n1 !< Number of cells in target grid + real, dimension(:), intent(in) :: dx1 !< Target grid edge positions (size n1+1) + integer, intent(in) :: method !< Remapping scheme to use + real, dimension(:), intent(out) :: u1 !< Target cell averages (size n1) + real, dimension(:), & + optional, intent(out) :: h1 !< Target grid widths (size n1) + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h. + ! Local variables + integer :: iTarget + real :: xL, xR ! coordinates of target cell edges + real :: xOld, hOld, uOld + real :: xNew, hNew, h_err + real :: uhNew, hFlux, uAve, fluxL, fluxR + integer :: jStart ! Used by integrateReconOnInterval() + real :: xStart ! Used by integrateReconOnInterval() + + ! Loop on cells in target grid. For each cell, iTarget, the left flux is + ! the right flux of the cell to the left, iTarget-1. + ! The left flux is initialized by started at iTarget=0 to calculate the + ! right flux which can take into account the target left boundary being + ! in the interior of the source domain. + fluxR = 0. + h_err = 0. ! For measuring round-off error + jStart = 1 + xStart = 0. + do iTarget = 0,n1 + fluxL = fluxR ! This does nothing for iTarget=0 + + if (iTarget == 0) then + xOld = 0. ! Left boundary is at x=0 + hOld = -1.E30 ! Should not be used for iTarget = 0 + uOld = -1.E30 ! Should not be used for iTarget = 0 + elseif (iTarget <= n0) then + xOld = xOld + h0(iTarget) ! Position of right edge of cell + hOld = h0(iTarget) + uOld = u0(iTarget) + h_err = h_err + epsilon(hOld) * max(hOld, xOld) + else + hOld = 0. ! as if for layers>n0, they were vanished + uOld = 1.E30 ! and the initial value should not matter + endif + xNew = xOld + dx1(iTarget+1) + xL = min( xOld, xNew ) + xR = max( xOld, xNew ) + + ! hFlux is the positive width of the remapped volume + hFlux = abs(dx1(iTarget+1)) + call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & + xL, xR, hFlux, uAve, jStart, xStart ) + ! uAve is the average value of u, independent of sign of dx1 + fluxR = dx1(iTarget+1)*uAve ! Includes sign of dx1 + + if (iTarget>0) then + hNew = hOld + ( dx1(iTarget+1) - dx1(iTarget) ) + hNew = max( 0., hNew ) + uhNew = ( uOld * hOld ) + ( fluxR - fluxL ) + if (hNew>0.) then + u1(iTarget) = uhNew / hNew + else + u1(iTarget) = uAve + endif + if (present(h1)) h1(iTarget) = hNew + endif + + enddo ! end iTarget loop on target grid cells + +end subroutine remapByDeltaZ + +!> Integrate the reconstructed column profile over a single cell +subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & + xL, xR, hC, uAve, jStart, xStart, h_neglect ) + integer, intent(in) :: n0 !< Number of cells in source grid + real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) + real, dimension(:), intent(in) :: u0 !< Source cell averages + real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial + real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial + integer, intent(in) :: method !< Remapping scheme to use + real, intent(in) :: xL !< Left edges of target cell + real, intent(in) :: xR !< Right edges of target cell + real, intent(in) :: hC !< Cell width hC = xR - xL + real, intent(out) :: uAve !< Average value on target cell + integer, intent(inout) :: jStart !< The index of the cell to start searching from + !< On exit, contains index of last cell used + real, intent(inout) :: xStart !< The left edge position of cell jStart + !< On first entry should be 0. + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h + ! Local variables + integer :: j, k + integer :: jL, jR ! indexes of source cells containing target + ! cell edges + real :: q ! complete integration + real :: xi0, xi1 ! interval of integration (local -- normalized + ! -- coordinates) + real :: x0jLl, x0jLr ! Left/right position of cell jL + real :: x0jRl, x0jRr ! Left/right position of cell jR + real :: hAct ! The distance actually used in the integration + ! (notionally xR - xL) which differs due to roundoff. + real :: x0_2, x1_2, x02px12, x0px1 ! Used in evaluation of integrated polynomials + real :: hNeglect ! A negligible thickness in the same units as h + real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials + + hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect + + q = -1.E30 + x0jLl = -1.E30 + x0jRl = -1.E30 + + ! Find the left most cell in source grid spanned by the target cell + jL = -1 + x0jLr = xStart + do j = jStart, n0 + x0jLl = x0jLr + x0jLr = x0jLl + h0(j) + ! Left edge is found in cell j + if ( ( xL >= x0jLl ) .AND. ( xL <= x0jLr ) ) then + jL = j + exit ! once target grid cell is found, exit loop + endif + enddo + jStart = jL + xStart = x0jLl + +! ! HACK to handle round-off problems. Need only at j=n0. +! ! This moves the effective cell boundary outwards a smidgen. +! if (xL>x0jLr) x0jLr = xL + + ! If, at this point, jL is equal to -1, it means the vanished + ! cell lies outside the source grid. In other words, it means that + ! the source and target grids do not cover the same physical domain + ! and there is something very wrong ! + if ( jL == -1 ) call MOM_error(FATAL, & + 'MOM_remapping, integrateReconOnInterval: '//& + 'The location of the left-most cell could not be found') + + + ! ============================================================ + ! Check whether target cell is vanished. If it is, the cell + ! average is simply the interpolated value at the location + ! of the vanished cell. If it isn't, we need to integrate the + ! quantity within the cell and divide by the cell width to + ! determine the cell average. + ! ============================================================ + ! 1. Cell is vanished + !if ( abs(xR - xL) <= epsilon(xR)*max(abs(xR),abs(xL)) ) then + if ( abs(xR - xL) == 0.0 ) then + + ! We check whether the source cell (i.e. the cell in which the + ! vanished target cell lies) is vanished. If it is, the interpolated + ! value is set to be mean of the edge values (which should be the same). + ! If it isn't, we simply interpolate. + if ( h0(jL) == 0.0 ) then + uAve = 0.5 * ( ppoly0_E(jL,1) + ppoly0_E(jL,2) ) + else + !### WHY IS THIS NOT WRITTEN AS xi0 = ( xL - x0jLl ) / h0(jL) ---AJA + xi0 = xL / ( h0(jL) + hNeglect ) - x0jLl / ( h0(jL) + hNeglect ) + + select case ( method ) + case ( INTEGRATION_PCM ) + uAve = ppoly0_coefs(jL,1) + case ( INTEGRATION_PLM ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ppoly0_coefs(jL,2) + case ( INTEGRATION_PPM ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ( ppoly0_coefs(jL,2) & + + xi0 * ppoly0_coefs(jL,3) ) + case ( INTEGRATION_PQM ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ( ppoly0_coefs(jL,2) & + + xi0 * ( ppoly0_coefs(jL,3) & + + xi0 * ( ppoly0_coefs(jL,4) & + + xi0 * ppoly0_coefs(jL,5) ) ) ) + case default + call MOM_error( FATAL,'The selected integration method is invalid' ) + end select + + endif ! end checking whether source cell is vanished + + ! 2. Cell is not vanished + else + + ! Find the right most cell in source grid spanned by the target cell + jR = -1 + x0jRr = xStart + do j = jStart,n0 + x0jRl = x0jRr + x0jRr = x0jRl + h0(j) + ! Right edge is found in cell j + if ( ( xR >= x0jRl ) .AND. ( xR <= x0jRr ) ) then + jR = j + exit ! once target grid cell is found, exit loop + endif + enddo ! end loop on source grid cells + + ! If xR>x0jRr then the previous loop reached j=n0 and the target + ! position, xR, was beyond the right edge of the source grid (h0). + ! This can happen due to roundoff, in which case we set jR=n0. + if (xR>x0jRr) jR = n0 + + ! To integrate, two cases must be considered: (1) the target cell is + ! entirely contained within a cell of the source grid and (2) the target + ! cell spans at least two cells of the source grid. + + if ( jL == jR ) then + ! The target cell is entirely contained within a cell of the source + ! grid. This situation is represented by the following schematic, where + ! the cell in which xL and xR are located has index jL=jR : + ! + ! ----|-----o--------o----------|------------- + ! xL xR + ! + ! Determine normalized coordinates +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) + xi1 = max( 0., min( 1., ( xR - x0jLl ) / ( h0(jL) + hNeglect ) ) ) +#else + xi0 = xL / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) + xi1 = xR / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) +#endif + + hAct = h0(jL) * ( xi1 - xi0 ) + + ! Depending on which polynomial is used, integrate quantity + ! between xi0 and xi1. Integration is carried out in normalized + ! coordinates, hence: \int_xL^xR p(x) dx = h \int_xi0^xi1 p(xi) dxi + select case ( method ) + case ( INTEGRATION_PCM ) + q = ( xR - xL ) * ppoly0_coefs(jL,1) + case ( INTEGRATION_PLM ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) + case ( INTEGRATION_PPM ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + case ( INTEGRATION_PQM ) + x0_2 = xi0*xi0 + x1_2 = xi1*xi1 + x02px12 = x0_2 + x1_2 + x0px1 = xi1 + xi0 + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + case default + call MOM_error( FATAL,'The selected integration method is invalid' ) + end select + + else + ! The target cell spans at least two cells of the source grid. + ! This situation is represented by the following schematic, where + ! the cells in which xL and xR are located have indexes jL and jR, + ! respectively : + ! + ! ----|-----o---|--- ... --|---o----------|------------- + ! xL xR + ! + ! We first integrate from xL up to the right boundary of cell jL, then + ! add the integrated amounts of cells located between jL and jR and then + ! integrate from the left boundary of cell jR up to xR + + q = 0.0 + + ! Integrate from xL up to right boundary of cell jL +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) +#else + xi0 = (xL - x0jLl) / ( h0(jL) + hNeglect ) +#endif + xi1 = 1.0 + + hAct = h0(jL) * ( xi1 - xi0 ) + + select case ( method ) + case ( INTEGRATION_PCM ) + q = q + ( x0jLr - xL ) * ppoly0_coefs(jL,1) + case ( INTEGRATION_PLM ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) + case ( INTEGRATION_PPM ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + case ( INTEGRATION_PQM ) + x0_2 = xi0*xi0 + x1_2 = xi1*xi1 + x02px12 = x0_2 + x1_2 + x0px1 = xi1 + xi0 + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + case default + call MOM_error( FATAL, 'The selected integration method is invalid' ) + end select + + ! Integrate contents within cells strictly comprised between jL and jR + if ( jR > (jL+1) ) then + do k = jL+1,jR-1 + q = q + h0(k) * u0(k) + hAct = hAct + h0(k) + enddo + endif + + ! Integrate from left boundary of cell jR up to xR + xi0 = 0.0 +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + xi1 = max( 0., min( 1., ( xR - x0jRl ) / ( h0(jR) + hNeglect ) ) ) +#else + xi1 = (xR - x0jRl) / ( h0(jR) + hNeglect ) +#endif + + hAct = hAct + h0(jR) * ( xi1 - xi0 ) + + select case ( method ) + case ( INTEGRATION_PCM ) + q = q + ( xR - x0jRl ) * ppoly0_coefs(jR,1) + case ( INTEGRATION_PLM ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) ) + case ( INTEGRATION_PPM ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jR,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + case ( INTEGRATION_PQM ) + x0_2 = xi0*xi0 + x1_2 = xi1*xi1 + x02px12 = x0_2 + x1_2 + x0px1 = xi1 + xi0 + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jR,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jR,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jR,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + case default + call MOM_error( FATAL,'The selected integration method is invalid' ) + end select + + endif ! end integration for non-vanished cells + + ! The cell average is the integrated value divided by the cell width +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ +if (hAct==0.) then + uAve = ppoly0_coefs(jL,1) +else + uAve = q / hAct +endif +#else + uAve = q / hC +#endif + + endif ! endif clause to check if cell is vanished + +end subroutine integrateReconOnInterval + +!> Calculates the change in interface positions based on h1 and h2 +subroutine dzFromH1H2( n1, h1, n2, h2, dx ) + integer, intent(in) :: n1 !< Number of cells on source grid + real, dimension(:), intent(in) :: h1 !< Cell widths of source grid (size n1) [H] + integer, intent(in) :: n2 !< Number of cells on target grid + real, dimension(:), intent(in) :: h2 !< Cell widths of target grid (size n2) [H] + real, dimension(:), intent(out) :: dx !< Change in interface position (size n2+1) [H] + ! Local variables + integer :: k + real :: x1, x2 ! Interface positions [H] + + x1 = 0. + x2 = 0. + dx(1) = 0. + do K = 1, max(n1,n2) + if (k <= n1) x1 = x1 + h1(k) ! Interface k+1, right of source cell k + if (k <= n2) then + x2 = x2 + h2(k) ! Interface k+1, right of target cell k + dx(K+1) = x2 - x1 ! Change of interface k+1, target - source + endif + enddo + +end subroutine dzFromH1H2 + +!> Calculate edge coordinate x from cell width h +subroutine buildGridFromH(nz, h, x) + integer, intent(in) :: nz !< Number of cells + real, dimension(nz), intent(in) :: h !< Cell widths [H] + real, dimension(nz+1), intent(inout) :: x !< Edge coordinates starting at x(1)=0 [H] + ! Local variables + integer :: k + + x(1) = 0.0 + do k = 1,nz + x(k+1) = x(k) + h(k) + enddo + +end subroutine buildGridFromH + +!> Runs unit tests on archaic remapping functions. +!! Should only be called from a single/root thread +!! Returns True if a test fails, otherwise False +logical function remapping_attic_unit_tests(verbose) + logical, intent(in) :: verbose !< If true, write results to stdout + ! Local variables + integer, parameter :: n0 = 4, n1 = 3, n2 = 6 + real :: h0(n0), x0(n0+1), u0(n0) + real :: h1(n1), x1(n1+1), u1(n1), hn1(n1), dx1(n1+1) + real :: h2(n2), x2(n2+1), u2(n2), hn2(n2), dx2(n2+1) + data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom + data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 + data h1 /3*1./ ! 3 uniform layers with total depth of 3 + data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 + real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs + integer :: answer_date ! The vintage of the expressions to test + integer :: i, degree + real :: err, h_neglect, h_neglect_edge + logical :: thisTest, v + + v = verbose + answer_date = 20190101 ! 20181231 + h_neglect = hNeglect_dflt + h_neglect_edge = hNeglect_dflt ; if (answer_date < 20190101) h_neglect_edge = 1.0e-10 + + write(stdout,*) '==== remapping_attic: remapping_attic_unit_tests =================' + remapping_attic_unit_tests = .false. ! Normally return false + + call buildGridFromH(n0, h0, x0) + call buildGridFromH(n1, h1, x1) + + thisTest = .false. + degree = 2 + if (verbose) write(stdout,*) 'h0 (test data)' + if (verbose) call dumpGrid(n0,h0,x0,u0) + + call dzFromH1H2( n0, h0, n1, h1, dx1 ) + + thisTest = .false. + allocate(ppoly0_E(n0,2)) + allocate(ppoly0_S(n0,2)) + allocate(ppoly0_coefs(n0,degree+1)) + + ppoly0_E(:,:) = 0.0 + ppoly0_S(:,:) = 0.0 + ppoly0_coefs(:,:) = 0.0 + + call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10, answer_date=answer_date ) + call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=answer_date ) + call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) + u1(:) = 0. + call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n1, h1, INTEGRATION_PPM, u1, h_neglect ) + do i=1,n1 + err = u1(i)-8.*(0.5*real(1+n1)-real(i)) + if (abs(err)>2.*epsilon(err)) thisTest = .true. + enddo + if (thisTest) write(stdout,*) 'remapping_attic_unit_tests: Failed remapByProjection()' + remapping_attic_unit_tests = remapping_attic_unit_tests .or. thisTest + + thisTest = .false. + u1(:) = 0. + call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n1, x1-x0(1:n1+1), & + INTEGRATION_PPM, u1, hn1, h_neglect ) + if (verbose) write(stdout,*) 'h1 (by delta)' + if (verbose) call dumpGrid(n1,h1,x1,u1) + hn1 = hn1-h1 + do i=1,n1 + err = u1(i)-8.*(0.5*real(1+n1)-real(i)) + if (abs(err)>2.*epsilon(err)) thisTest = .true. + enddo + if (thisTest) write(stdout,*) 'remapping_attic_unit_tests: Failed remapByDeltaZ() 1' + remapping_attic_unit_tests = remapping_attic_unit_tests .or. thisTest + + thisTest = .false. + call buildGridFromH(n2, h2, x2) + dx2(1:n0+1) = x2(1:n0+1) - x0 + dx2(n0+2:n2+1) = x2(n0+2:n2+1) - x0(n0+1) + call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n2, dx2, & + INTEGRATION_PPM, u2, hn2, h_neglect ) + if (verbose) write(stdout,*) 'h2' + if (verbose) call dumpGrid(n2,h2,x2,u2) + if (verbose) write(stdout,*) 'hn2' + if (verbose) call dumpGrid(n2,hn2,x2,u2) + + do i=1,n2 + err = u2(i)-8./2.*(0.5*real(1+n2)-real(i)) + if (abs(err)>2.*epsilon(err)) thisTest = .true. + enddo + if (thisTest) write(stdout,*) 'remapping_attic_unit_tests: Failed remapByDeltaZ() 2' + remapping_attic_unit_tests = remapping_attic_unit_tests .or. thisTest + + if (.not. remapping_attic_unit_tests) write(stdout,*) 'Pass' + +end function remapping_attic_unit_tests + +!> Convenience function for printing grid to screen +subroutine dumpGrid(n,h,x,u) + integer, intent(in) :: n !< Number of cells + real, dimension(:), intent(in) :: h !< Cell thickness [H] + real, dimension(:), intent(in) :: x !< Interface delta [H] + real, dimension(:), intent(in) :: u !< Cell average values [A] + integer :: i + write(stdout,'("i=",20i10)') (i,i=1,n+1) + write(stdout,'("x=",20es10.2)') (x(i),i=1,n+1) + write(stdout,'("i=",5x,20i10)') (i,i=1,n) + write(stdout,'("h=",5x,20es10.2)') (h(i),i=1,n) + write(stdout,'("u=",5x,20es10.2)') (u(i),i=1,n) +end subroutine dumpGrid + +end module remapping_attic From f93728875bf92a91b1212e5be366e02fd15f3417 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Oct 2022 11:43:17 -0400 Subject: [PATCH 009/213] +Move interpolate_column to MOM_remapping.F90 Moved interpolate_column and reintegrate_column (without changing anything) from MOM_diag_vkernels.F90 to MOM_remapping.F90 and incorporated the tests that had been in diag_vkernels_unit_tests into remapping_unit_tests. The entire MOM_diag_vkernels.F90 file was then removed. All answers are bitwise identical, although the module for two public routines was changed and a third was eliminated. --- src/ALE/MOM_ALE.F90 | 2 +- src/ALE/MOM_remapping.F90 | 334 +++++++++++++++- src/core/MOM_unit_tests.F90 | 3 - src/framework/MOM_diag_remap.F90 | 5 +- src/framework/MOM_diag_vkernels.F90 | 357 ------------------ src/tracer/MOM_lateral_boundary_diffusion.F90 | 3 +- src/tracer/MOM_offline_aux.F90 | 2 +- 7 files changed, 337 insertions(+), 369 deletions(-) delete mode 100644 src/framework/MOM_diag_vkernels.F90 diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 8116ba3e17..5fd84c73c9 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -13,7 +13,6 @@ module MOM_ALE use MOM_debugging, only : check_column_integrals use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl use MOM_diag_mediator, only : time_type, diag_update_remap_grids, query_averaging_enabled -use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_error_handler, only : callTree_showQuery @@ -40,6 +39,7 @@ module MOM_ALE use MOM_remapping, only : initialize_remapping, end_remapping use MOM_remapping, only : remapping_core_h, remapping_core_w use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme +use MOM_remapping, only : interpolate_column, reintegrate_column use MOM_remapping, only : remapping_CS, dzFromH1H2 use MOM_string_functions, only : uppercase, extractWord, extract_integer use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chkinv diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 061894711c..20d3930d69 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -42,7 +42,7 @@ module MOM_remapping public remapping_core_h, remapping_core_w public initialize_remapping, end_remapping, remapping_set_param, extract_member_remapping_CS public remapping_unit_tests, build_reconstructions_1d, average_value_ppoly -public dzFromH1H2 +public interpolate_column, reintegrate_column, dzFromH1H2 ! The following are private parameter constants integer, parameter :: REMAPPING_PCM = 0 !< O(h^1) remapping scheme @@ -919,6 +919,157 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth end subroutine remap_via_sub_cells +!> Linearly interpolate interface data, u_src, from grid h_src to a grid h_dest +subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells + real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells + real, intent(in) :: missing_value !< Value to assign in vanished cells + real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces + ! Local variables + real :: x_dest ! Relative position of target interface + real :: dh ! Source cell thickness + real :: u1, u2 ! Values to interpolate between + real :: weight_a, weight_b ! Weights for interpolation + integer :: k_src, k_dest ! Index of cell in src and dest columns + logical :: still_vanished ! Used for figuring out what to mask as missing + + ! Initial values for the loop + still_vanished = .true. + + ! The following forces the "do while" loop to do one cycle that will set u1, u2, dh. + k_src = 0 + dh = 0. + x_dest = 0. + + do k_dest=1, ndest+1 + do while (dh<=x_dest .and. k_src0.) then + weight_a = max(0., ( dh - x_dest ) / dh) ! Weight of u1 + weight_b = min(1., x_dest / dh) ! Weight of u2 + u_dest(k_dest) = weight_a * u1 + weight_b * u2 ! Linear interpolation between u1 and u2 + else + u_dest(k_dest) = 0.5 * ( u1 + u2 ) ! For a vanished layer we need to do something reasonable... + endif + + ! Mask vanished layers at the surface which would be under an ice-shelf. + ! TODO: Need to figure out what to do for an isopycnal coordinate diagnostic that could + ! also have vanished layers at the surface. + if (k_dest<=ndest) then + x_dest = x_dest + h_dest(k_dest) ! Position of interface k_dest+1 + if (still_vanished .and. h_dest(k_dest)==0.) then + ! When the layer k_dest is vanished and all layers above are also vanished, the k_dest + ! interface value should be missing. + u_dest(k_dest) = missing_value + else + still_vanished = .false. + endif + endif + + enddo + + ! Mask vanished layers on topography + still_vanished = .true. + do k_dest=ndest, 1, -1 + if (still_vanished .and. h_dest(k_dest)==0.) then + ! When the layer k_dest is vanished and all layers below are also vanished, the k_dest+1 + ! interface value should be missing. + u_dest(k_dest+1) = missing_value + else + exit + endif + enddo + +end subroutine interpolate_column + +!> Conservatively calculate integrated data, uh_dest, on grid h_dest, from layer-integrated data, uh_src, on grid h_src +subroutine reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells + real, dimension(nsrc), intent(in) :: uh_src !< Values at source cell interfaces + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells + real, intent(in) :: missing_value !< Value to assign in vanished cells + real, dimension(ndest), intent(inout) :: uh_dest !< Interpolated value at destination cell interfaces + + ! Local variables + real :: h_src_rem, h_dest_rem, dh ! Incremental thicknesses + real :: uh_src_rem, duh ! Incremental amounts of stuff + integer :: k_src, k_dest ! Index of cell in src and dest columns + logical :: src_ran_out, src_exists + + uh_dest(:) = missing_value + + k_src = 0 + k_dest = 0 + h_dest_rem = 0. + h_src_rem = 0. + src_ran_out = .false. + src_exists = .false. + + do while(.true.) + if (h_src_rem==0. .and. k_src0.) duh = uh_src_rem + h_src_rem = 0. + uh_src_rem = 0. + h_dest_rem = max(0., h_dest_rem - dh) + elseif (h_src_rem>h_dest_rem) then + ! Only part of the source cell can be used up + dh = h_dest_rem + duh = (dh / h_src_rem) * uh_src_rem + h_src_rem = max(0., h_src_rem - dh) + uh_src_rem = uh_src_rem - duh + h_dest_rem = 0. + else ! h_src_rem==h_dest_rem + ! The source cell exactly fits the destination cell + duh = uh_src_rem + h_src_rem = 0. + uh_src_rem = 0. + h_dest_rem = 0. + endif + uh_dest(k_dest) = uh_dest(k_dest) + duh + if (k_dest==ndest .and. (k_src==nsrc .or. h_dest_rem==0.)) exit + enddo + + if (.not. src_exists) uh_dest(1:ndest) = missing_value + +end subroutine reintegrate_column + !> Returns the average value of a reconstruction within a single source cell, i0, !! between the non-dimensional positions xa and xb (xa<=xb) with dimensional !! separation dh. @@ -1209,12 +1360,13 @@ logical function remapping_unit_tests(verbose) real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs integer :: answer_date ! The vintage of the expressions to test integer :: i + real, parameter :: mv=-9.999999999E9 ! Value to use for vanished layers in interpolation tests. real, parameter :: hNeglect_dflt = 1.0e-30 ! A thickness [H ~> m or kg m-2] that can be ! added to thicknesses in a denominator without ! changing the numerical result, except where ! a division by zero would otherwise occur. real :: err, h_neglect, h_neglect_edge - logical :: thisTest, v + logical :: thisTest, v, fail v = verbose answer_date = 20190101 ! 20181231 @@ -1429,6 +1581,108 @@ logical function remapping_unit_tests(verbose) if (.not. remapping_unit_tests) write(stdout,*) 'Pass' + write(stdout,*) '=== MOM_remapping: interpolation and reintegration unit tests ===' + if (verbose) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' + + fail = test_interp(v,mv,'Identity: 3 layer', & + 3, (/1.,2.,3./), (/1.,2.,3.,4./), & + 3, (/1.,2.,3./), (/1.,2.,3.,4./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'A: 3 layer to 2', & + 3, (/1.,1.,1./), (/1.,2.,3.,4./), & + 2, (/1.5,1.5/), (/1.,2.5,4./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'B: 2 layer to 3', & + 2, (/1.5,1.5/), (/1.,4.,7./), & + 3, (/1.,1.,1./), (/1.,3.,5.,7./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'C: 3 layer (vanished middle) to 2', & + 3, (/1.,0.,2./), (/1.,2.,2.,3./), & + 2, (/1.,2./), (/1.,2.,3./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'D: 3 layer (deep) to 3', & + 3, (/1.,2.,3./), (/1.,2.,4.,7./), & + 2, (/2.,2./), (/1.,3.,5./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'E: 3 layer to 3 (deep)', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 3, (/2.,3.,4./), (/1.,3.,6.,8./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'F: 3 layer to 4 with vanished top/botton', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 4, (/0.,2.,5.,0./), (/mv,1.,3.,8.,mv/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'Fs: 3 layer to 4 with vanished top/botton (shallow)', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 4, (/0.,2.,4.,0./), (/mv,1.,3.,7.,mv/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(v,mv,'Fd: 3 layer to 4 with vanished top/botton (deep)', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 4, (/0.,2.,6.,0./), (/mv,1.,3.,8.,mv/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + if (verbose) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' + + fail = test_reintegrate(v,mv,'Identity: 3 layer', & + 3, (/1.,2.,3./), (/-5.,2.,1./), & + 3, (/1.,2.,3./), (/-5.,2.,1./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'A: 3 layer to 2', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 2, (/3.,3./), (/-4.,2./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'A: 3 layer to 2 (deep)', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 2, (/3.,4./), (/-4.,2./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'A: 3 layer to 2 (shallow)', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 2, (/3.,2./), (/-4.,1.5/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'B: 3 layer to 4 with vanished top/bottom', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 4, (/0.,3.,3.,0./), (/0.,-4.,2.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'C: 3 layer to 4 with vanished top//middle/bottom', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 5, (/0.,3.,0.,3.,0./), (/0.,-4.,0.,2.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'D: 3 layer to 3 (vanished)', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 3, (/0.,0.,0./), (/0.,0.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3', & + 3, (/0.,0.,0./), (/-5.,2.,1./), & + 3, (/2.,2.,2./), (/mv, mv, mv/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & + 3, (/0.,0.,0./), (/-5.,2.,1./), & + 3, (/0.,0.,0./), (/mv, mv, mv/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & + 3, (/0.,0.,0./), (/0.,0.,0./), & + 3, (/0.,0.,0./), (/mv, mv, mv/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + if (.not. remapping_unit_tests) write(stdout,*) 'Pass' + end function remapping_unit_tests !> Returns true if any cell of u and u_true are not identical. Returns false otherwise. @@ -1462,6 +1716,82 @@ logical function test_answer(verbose, n, u, u_true, label, tol) end function test_answer +!> Returns true if a test of interpolate_column() produces the wrong answer +logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, ndest, h_dest, u_true) + logical, intent(in) :: verbose !< If true, write results to stdout + real, intent(in) :: missing_value !< Value to indicate missing data + character(len=*), intent(in) :: msg !< Message to label test + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces [A] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest+1), intent(in) :: u_true !< Correct value at destination cell interfaces [A] + ! Local variables + real, dimension(ndest+1) :: u_dest ! Interpolated value at destination cell interfaces [A] + integer :: k + real :: error + + ! Interpolate from src to dest + call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) + + test_interp = .false. + do k=1,ndest+1 + if (u_dest(k)/=u_true(k)) test_interp = .true. + enddo + if (verbose .or. test_interp) then + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','u_result','u_true','error' + do k=1,ndest+1 + error = u_dest(k)-u_true(k) + if (error==0.) then + write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) + else + write(stdout,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + endif + enddo + endif +end function test_interp + +!> Returns true if a test of reintegrate_column() produces the wrong answer +logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_src, ndest, h_dest, uh_true) + logical, intent(in) :: verbose !< If true, write results to stdout + real, intent(in) :: missing_value !< Value to indicate missing data [A H] + character(len=*), intent(in) :: msg !< Message to label test + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc), intent(in) :: uh_src !< Values of source cell stuff [A H] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest), intent(in) :: uh_true !< Correct value of destination cell stuff [A H] + ! Local variables + real, dimension(ndest) :: uh_dest ! Reintegrated value on destination cells [A H] + integer :: k + real :: error + + ! Interpolate from src to dest + call reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) + + test_reintegrate = .false. + do k=1,ndest + if (uh_dest(k)/=uh_true(k)) test_reintegrate = .true. + enddo + if (verbose .or. test_reintegrate) then + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','uh_result','uh_true','error' + do k=1,ndest + error = uh_dest(k)-uh_true(k) + if (error==0.) then + write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) + else + write(stdout,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + endif + enddo + endif +end function test_reintegrate + !> Convenience function for printing grid to screen subroutine dumpGrid(n,h,x,u) integer, intent(in) :: n !< Number of cells diff --git a/src/core/MOM_unit_tests.F90 b/src/core/MOM_unit_tests.F90 index 08f8dea634..10782e8890 100644 --- a/src/core/MOM_unit_tests.F90 +++ b/src/core/MOM_unit_tests.F90 @@ -8,7 +8,6 @@ module MOM_unit_tests use MOM_string_functions, only : string_functions_unit_tests use MOM_remapping, only : remapping_unit_tests use MOM_neutral_diffusion, only : neutral_diffusion_unit_tests -use MOM_diag_vkernels, only : diag_vkernels_unit_tests use MOM_random, only : random_unit_tests use MOM_lateral_boundary_diffusion, only : near_boundary_unit_tests use MOM_CFC_cap, only : CFC_cap_unit_tests @@ -35,8 +34,6 @@ subroutine unit_tests(verbosity) "MOM_unit_tests: remapping_unit_tests FAILED") if (neutral_diffusion_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: neutralDiffusionUnitTests FAILED") - if (diag_vkernels_unit_tests(verbose)) call MOM_error(FATAL, & - "MOM_unit_tests: diag_vkernels_unit_tests FAILED") if (random_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: random_unit_tests FAILED") if (near_boundary_unit_tests(verbose)) call MOM_error(FATAL, & diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 1bdf13b41f..eae498f5cb 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -62,15 +62,14 @@ module MOM_diag_remap use MOM_error_handler, only : MOM_error, FATAL, assert, WARNING use MOM_debugging, only : check_column_integrals use MOM_diag_manager_infra,only : MOM_diag_axis_init -use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_file_parser, only : get_param, log_param, param_file_type use MOM_string_functions, only : lowercase, extractWord use MOM_grid, only : ocean_grid_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type -use MOM_remapping, only : remapping_CS, initialize_remapping -use MOM_remapping, only : remapping_core_h +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_remapping, only : interpolate_column, reintegrate_column use MOM_regridding, only : regridding_CS, initialize_regridding use MOM_regridding, only : end_regridding use MOM_regridding, only : set_regrid_params, get_regrid_size diff --git a/src/framework/MOM_diag_vkernels.F90 b/src/framework/MOM_diag_vkernels.F90 deleted file mode 100644 index 886f6dcd4d..0000000000 --- a/src/framework/MOM_diag_vkernels.F90 +++ /dev/null @@ -1,357 +0,0 @@ -!> Provides kernels for single-column interpolation, re-integration (re-mapping of integrated quantities) -!! and intensive-variable remapping in the vertical -module MOM_diag_vkernels - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_io, only : stdout, stderr - -implicit none ; private - -public diag_vkernels_unit_tests -public interpolate_column -public reintegrate_column - -contains - -!> Linearly interpolate interface data, u_src, from grid h_src to a grid h_dest -subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, intent(in) :: missing_value !< Value to assign in vanished cells - real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces - ! Local variables - real :: x_dest ! Relative position of target interface - real :: dh ! Source cell thickness - real :: u1, u2 ! Values to interpolate between - real :: weight_a, weight_b ! Weights for interpolation - integer :: k_src, k_dest ! Index of cell in src and dest columns - logical :: still_vanished ! Used for figuring out what to mask as missing - - ! Initial values for the loop - still_vanished = .true. - - ! The following forces the "do while" loop to do one cycle that will set u1, u2, dh. - k_src = 0 - dh = 0. - x_dest = 0. - - do k_dest=1, ndest+1 - do while (dh<=x_dest .and. k_src0.) then - weight_a = max(0., ( dh - x_dest ) / dh) ! Weight of u1 - weight_b = min(1., x_dest / dh) ! Weight of u2 - u_dest(k_dest) = weight_a * u1 + weight_b * u2 ! Linear interpolation between u1 and u2 - else - u_dest(k_dest) = 0.5 * ( u1 + u2 ) ! For a vanished layer we need to do something reasonable... - endif - - ! Mask vanished layers at the surface which would be under an ice-shelf. - ! TODO: Need to figure out what to do for an isopycnal coordinate diagnostic that could - ! also have vanished layers at the surface. - if (k_dest<=ndest) then - x_dest = x_dest + h_dest(k_dest) ! Position of interface k_dest+1 - if (still_vanished .and. h_dest(k_dest)==0.) then - ! When the layer k_dest is vanished and all layers above are also vanished, the k_dest - ! interface value should be missing. - u_dest(k_dest) = missing_value - else - still_vanished = .false. - endif - endif - - enddo - - ! Mask vanished layers on topography - still_vanished = .true. - do k_dest=ndest, 1, -1 - if (still_vanished .and. h_dest(k_dest)==0.) then - ! When the layer k_dest is vanished and all layers below are also vanished, the k_dest+1 - ! interface value should be missing. - u_dest(k_dest+1) = missing_value - else - exit - endif - enddo - -end subroutine interpolate_column - -!> Conservatively calculate integrated data, uh_dest, on grid h_dest, from layer-integrated data, uh_src, on grid h_src -subroutine reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc), intent(in) :: uh_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, intent(in) :: missing_value !< Value to assign in vanished cells - real, dimension(ndest), intent(inout) :: uh_dest !< Interpolated value at destination cell interfaces - - ! Local variables - real :: h_src_rem, h_dest_rem, dh ! Incremental thicknesses - real :: uh_src_rem, duh ! Incremental amounts of stuff - integer :: k_src, k_dest ! Index of cell in src and dest columns - logical :: src_ran_out, src_exists - - uh_dest(:) = missing_value - - k_src = 0 - k_dest = 0 - h_dest_rem = 0. - h_src_rem = 0. - src_ran_out = .false. - src_exists = .false. - - do while(.true.) - if (h_src_rem==0. .and. k_src0.) duh = uh_src_rem - h_src_rem = 0. - uh_src_rem = 0. - h_dest_rem = max(0., h_dest_rem - dh) - elseif (h_src_rem>h_dest_rem) then - ! Only part of the source cell can be used up - dh = h_dest_rem - duh = (dh / h_src_rem) * uh_src_rem - h_src_rem = max(0., h_src_rem - dh) - uh_src_rem = uh_src_rem - duh - h_dest_rem = 0. - else ! h_src_rem==h_dest_rem - ! The source cell exactly fits the destination cell - duh = uh_src_rem - h_src_rem = 0. - uh_src_rem = 0. - h_dest_rem = 0. - endif - uh_dest(k_dest) = uh_dest(k_dest) + duh - if (k_dest==ndest .and. (k_src==nsrc .or. h_dest_rem==0.)) exit - enddo - - if (.not. src_exists) uh_dest(1:ndest) = missing_value - -end subroutine reintegrate_column - -!> Returns true if any unit tests for module MOM_diag_vkernels fail -logical function diag_vkernels_unit_tests(verbose) - logical, intent(in) :: verbose !< If true, write results to stdout - ! Local variables - real, parameter :: mv=-9.999999999E9 ! Value to use for vanished layers - logical :: fail, v - - v = verbose - - write(stdout,*) '==== MOM_diag_kernels: diag_vkernels_unit_tests ==========' - if (v) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' - - fail = test_interp(v,mv,'Identity: 3 layer', & - 3, (/1.,2.,3./), (/1.,2.,3.,4./), & - 3, (/1.,2.,3./), (/1.,2.,3.,4./) ) - diag_vkernels_unit_tests = fail - - fail = test_interp(v,mv,'A: 3 layer to 2', & - 3, (/1.,1.,1./), (/1.,2.,3.,4./), & - 2, (/1.5,1.5/), (/1.,2.5,4./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'B: 2 layer to 3', & - 2, (/1.5,1.5/), (/1.,4.,7./), & - 3, (/1.,1.,1./), (/1.,3.,5.,7./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'C: 3 layer (vanished middle) to 2', & - 3, (/1.,0.,2./), (/1.,2.,2.,3./), & - 2, (/1.,2./), (/1.,2.,3./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'D: 3 layer (deep) to 3', & - 3, (/1.,2.,3./), (/1.,2.,4.,7./), & - 2, (/2.,2./), (/1.,3.,5./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'E: 3 layer to 3 (deep)', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 3, (/2.,3.,4./), (/1.,3.,6.,8./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'F: 3 layer to 4 with vanished top/botton', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,5.,0./), (/mv,1.,3.,8.,mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'Fs: 3 layer to 4 with vanished top/botton (shallow)', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,4.,0./), (/mv,1.,3.,7.,mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'Fd: 3 layer to 4 with vanished top/botton (deep)', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,6.,0./), (/mv,1.,3.,8.,mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - if (v) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' - - fail = test_reintegrate(v,mv,'Identity: 3 layer', & - 3, (/1.,2.,3./), (/-5.,2.,1./), & - 3, (/1.,2.,3./), (/-5.,2.,1./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'A: 3 layer to 2', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 2, (/3.,3./), (/-4.,2./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'A: 3 layer to 2 (deep)', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 2, (/3.,4./), (/-4.,2./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'A: 3 layer to 2 (shallow)', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 2, (/3.,2./), (/-4.,1.5/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'B: 3 layer to 4 with vanished top/bottom', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 4, (/0.,3.,3.,0./), (/0.,-4.,2.,0./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'C: 3 layer to 4 with vanished top//middle/bottom', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 5, (/0.,3.,0.,3.,0./), (/0.,-4.,0.,2.,0./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer to 3 (vanished)', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 3, (/0.,0.,0./), (/0.,0.,0./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3', & - 3, (/0.,0.,0./), (/-5.,2.,1./), & - 3, (/2.,2.,2./), (/mv, mv, mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & - 3, (/0.,0.,0./), (/-5.,2.,1./), & - 3, (/0.,0.,0./), (/mv, mv, mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & - 3, (/0.,0.,0./), (/0.,0.,0./), & - 3, (/0.,0.,0./), (/mv, mv, mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - if (.not. fail) write(stdout,*) 'Pass' - -end function diag_vkernels_unit_tests - -!> Returns true if a test of interpolate_column() produces the wrong answer -logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, ndest, h_dest, u_true) - logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: missing_value !< Value to indicate missing data - character(len=*), intent(in) :: msg !< Message to label test - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, dimension(ndest+1), intent(in) :: u_true !< Correct value at destination cell interfaces - ! Local variables - real, dimension(ndest+1) :: u_dest ! Interpolated value at destination cell interfaces - integer :: k - real :: error - - ! Interpolate from src to dest - call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) - - test_interp = .false. - do k=1,ndest+1 - if (u_dest(k)/=u_true(k)) test_interp = .true. - enddo - if (verbose .or. test_interp) then - write(stdout,'(2a)') ' Test: ',msg - write(stdout,'(a3,3(a24))') 'k','u_result','u_true','error' - do k=1,ndest+1 - error = u_dest(k)-u_true(k) - if (error==0.) then - write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) - else - write(stdout,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' - write(stderr,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' - endif - enddo - endif -end function test_interp - -!> Returns true if a test of reintegrate_column() produces the wrong answer -logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_src, ndest, h_dest, uh_true) - logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: missing_value !< Value to indicate missing data - character(len=*), intent(in) :: msg !< Message to label test - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc), intent(in) :: uh_src !< Values of source cell stuff - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, dimension(ndest), intent(in) :: uh_true !< Correct value of destination cell stuff - ! Local variables - real, dimension(ndest) :: uh_dest ! Reintegrated value on destination cells - integer :: k - real :: error - - ! Interpolate from src to dest - call reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) - - test_reintegrate = .false. - do k=1,ndest - if (uh_dest(k)/=uh_true(k)) test_reintegrate = .true. - enddo - if (verbose .or. test_reintegrate) then - write(stdout,'(2a)') ' Test: ',msg - write(stdout,'(a3,3(a24))') 'k','uh_result','uh_true','error' - do k=1,ndest - error = uh_dest(k)-uh_true(k) - if (error==0.) then - write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) - else - write(stdout,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' - write(stderr,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' - endif - enddo - endif -end function test_reintegrate - -end module MOM_diag_vkernels diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index e7e47370e1..1bd5500023 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -11,11 +11,10 @@ module MOM_lateral_boundary_diffusion use MOM_domains, only : pass_var use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : post_data, register_diag_field -use MOM_diag_vkernels, only : reintegrate_column use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_remapping, only : remapping_CS, initialize_remapping +use MOM_remapping, only : remapping_CS, initialize_remapping, reintegrate_column use MOM_remapping, only : extract_member_remapping_CS, remapping_core_h use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme use MOM_spatial_means, only : global_mass_integral diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 0a56925516..ab37b87f17 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -7,13 +7,13 @@ module MOM_offline_aux use MOM_debugging, only : check_column_integrals use MOM_domains, only : pass_var, pass_vector, To_All use MOM_diag_mediator, only : post_data -use MOM_diag_vkernels, only : reintegrate_column use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER use MOM_opacity, only : optics_type +use MOM_remapping, only : reintegrate_column use MOM_time_manager, only : time_type, operator(-) use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : vertvisc_type From 1faf2a8a4a44a7347286885bca24a5db9a724ebc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Oct 2022 13:21:51 -0400 Subject: [PATCH 010/213] +Remove missing_value arg to interpolate_column Remove missing_value arguments to interpolate_column and reintegrate_column, instead using 0 for the values in vanished cells. This change helps to address github.com/mom-ocean/MOM6/issues/769. Also added comments schematically describing some of the argument units. Because 0 was already being used for the missing value (except in unit tests), all solutions are bitwise identical. --- src/ALE/MOM_ALE.F90 | 6 +- src/ALE/MOM_remapping.F90 | 142 +++++++++--------- src/framework/MOM_diag_remap.F90 | 12 +- src/tracer/MOM_lateral_boundary_diffusion.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 1 - 5 files changed, 79 insertions(+), 84 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 5fd84c73c9..ec71e15bbd 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -536,7 +536,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) if (G%mask2dCu(i,j)>0.) then h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:)) h_dest(:) = 0.5 * (h_new(i,j,:) + h_new(i+1,j,:)) - call reintegrate_column(nk, h_src, uhtr(I,j,:), nk, h_dest, 0., temp_vec) + call reintegrate_column(nk, h_src, uhtr(I,j,:), nk, h_dest, temp_vec) uhtr(I,j,:) = temp_vec endif enddo ; enddo @@ -544,7 +544,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) if (G%mask2dCv(i,j)>0.) then h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:)) h_dest(:) = 0.5 * (h_new(i,j,:) + h_new(i,j+1,:)) - call reintegrate_column(nk, h_src, vhtr(I,j,:), nk, h_dest, 0., temp_vec) + call reintegrate_column(nk, h_src, vhtr(I,j,:), nk, h_dest, temp_vec) vhtr(I,j,:) = temp_vec endif enddo ; enddo @@ -554,7 +554,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) if (check_column_integrals(nk, h_src, nk, h_dest)) then call MOM_error(FATAL, "ALE_offline_inputs: Kd interpolation columns do not match") endif - call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), 0., Kd(i,j,:)) + call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), Kd(i,j,:)) endif enddo ; enddo diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 20d3930d69..ad8fe48fbf 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -920,19 +920,19 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth end subroutine remap_via_sub_cells !> Linearly interpolate interface data, u_src, from grid h_src to a grid h_dest -subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, intent(in) :: missing_value !< Value to assign in vanished cells - real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces +subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest) + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces [A] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces [A] + ! Local variables - real :: x_dest ! Relative position of target interface - real :: dh ! Source cell thickness - real :: u1, u2 ! Values to interpolate between - real :: weight_a, weight_b ! Weights for interpolation + real :: x_dest ! Relative position of target interface [H] + real :: dh ! Source cell thickness [H] + real :: u1, u2 ! Values to interpolate between [A] + real :: weight_a, weight_b ! Weights for interpolation [nondim] integer :: k_src, k_dest ! Index of cell in src and dest columns logical :: still_vanished ! Used for figuring out what to mask as missing @@ -972,7 +972,7 @@ subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, if (still_vanished .and. h_dest(k_dest)==0.) then ! When the layer k_dest is vanished and all layers above are also vanished, the k_dest ! interface value should be missing. - u_dest(k_dest) = missing_value + u_dest(k_dest) = 0.0 else still_vanished = .false. endif @@ -986,7 +986,7 @@ subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, if (still_vanished .and. h_dest(k_dest)==0.) then ! When the layer k_dest is vanished and all layers below are also vanished, the k_dest+1 ! interface value should be missing. - u_dest(k_dest+1) = missing_value + u_dest(k_dest+1) = 0.0 else exit endif @@ -995,29 +995,27 @@ subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, end subroutine interpolate_column !> Conservatively calculate integrated data, uh_dest, on grid h_dest, from layer-integrated data, uh_src, on grid h_src -subroutine reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc), intent(in) :: uh_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, intent(in) :: missing_value !< Value to assign in vanished cells - real, dimension(ndest), intent(inout) :: uh_dest !< Interpolated value at destination cell interfaces +subroutine reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, uh_dest) + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc), intent(in) :: uh_src !< Values at source cell interfaces [A H] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest), intent(inout) :: uh_dest !< Interpolated value at destination cell interfaces [A H] ! Local variables - real :: h_src_rem, h_dest_rem, dh ! Incremental thicknesses - real :: uh_src_rem, duh ! Incremental amounts of stuff + real :: h_src_rem, h_dest_rem, dh ! Incremental thicknesses [H] + real :: uh_src_rem, duh ! Incremental amounts of stuff [A H] integer :: k_src, k_dest ! Index of cell in src and dest columns - logical :: src_ran_out, src_exists + logical :: src_ran_out - uh_dest(:) = missing_value + uh_dest(:) = 0.0 k_src = 0 k_dest = 0 h_dest_rem = 0. h_src_rem = 0. src_ran_out = .false. - src_exists = .false. do while(.true.) if (h_src_rem==0. .and. k_src Returns the average value of a reconstruction within a single source cell, i0, @@ -1349,23 +1344,26 @@ logical function remapping_unit_tests(verbose) logical, intent(in) :: verbose !< If true, write results to stdout ! Local variables integer, parameter :: n0 = 4, n1 = 3, n2 = 6 - real :: h0(n0), x0(n0+1), u0(n0) - real :: h1(n1), x1(n1+1), u1(n1), dx1(n1+1) - real :: h2(n2), x2(n2+1), u2(n2) - data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom - data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 - data h1 /3*1./ ! 3 uniform layers with total depth of 3 - data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 + real :: h0(n0), x0(n0+1), u0(n0) ! Thicknesses [H], interface heights [H] and values [A] for profile 0 + real :: h1(n1), x1(n1+1), u1(n1) ! Thicknesses [H], interface heights [H] and values [A] for profile 1 + real :: dx1(n1+1) ! Interface height changes for profile 1 [H] + real :: h2(n2), x2(n2+1), u2(n2) ! Thicknesses [H], interface heights [H] and values [A] for profile 2 + data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom [A] + data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 [H] + data h1 /3*1./ ! 3 uniform layers with total depth of 3 [H] + data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 [H] type(remapping_CS) :: CS !< Remapping control structure - real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs + real, allocatable, dimension(:,:) :: ppoly0_E ! Edge values of polynomials [A] + real, allocatable, dimension(:,:) :: ppoly0_S ! Edge slopes of polynomials [A H-1] + real, allocatable, dimension(:,:) :: ppoly0_coefs ! Coefficients of polynomials [A] integer :: answer_date ! The vintage of the expressions to test integer :: i - real, parameter :: mv=-9.999999999E9 ! Value to use for vanished layers in interpolation tests. real, parameter :: hNeglect_dflt = 1.0e-30 ! A thickness [H ~> m or kg m-2] that can be ! added to thicknesses in a denominator without ! changing the numerical result, except where ! a division by zero would otherwise occur. - real :: err, h_neglect, h_neglect_edge + real :: err ! Errors in the remapped thicknesses [H] or values [A] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H] logical :: thisTest, v, fail v = verbose @@ -1584,101 +1582,101 @@ logical function remapping_unit_tests(verbose) write(stdout,*) '=== MOM_remapping: interpolation and reintegration unit tests ===' if (verbose) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' - fail = test_interp(v,mv,'Identity: 3 layer', & + fail = test_interp(verbose, 'Identity: 3 layer', & 3, (/1.,2.,3./), (/1.,2.,3.,4./), & 3, (/1.,2.,3./), (/1.,2.,3.,4./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'A: 3 layer to 2', & + fail = test_interp(verbose, 'A: 3 layer to 2', & 3, (/1.,1.,1./), (/1.,2.,3.,4./), & 2, (/1.5,1.5/), (/1.,2.5,4./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'B: 2 layer to 3', & + fail = test_interp(verbose, 'B: 2 layer to 3', & 2, (/1.5,1.5/), (/1.,4.,7./), & 3, (/1.,1.,1./), (/1.,3.,5.,7./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'C: 3 layer (vanished middle) to 2', & + fail = test_interp(verbose, 'C: 3 layer (vanished middle) to 2', & 3, (/1.,0.,2./), (/1.,2.,2.,3./), & 2, (/1.,2./), (/1.,2.,3./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'D: 3 layer (deep) to 3', & + fail = test_interp(verbose, 'D: 3 layer (deep) to 3', & 3, (/1.,2.,3./), (/1.,2.,4.,7./), & 2, (/2.,2./), (/1.,3.,5./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'E: 3 layer to 3 (deep)', & + fail = test_interp(verbose, 'E: 3 layer to 3 (deep)', & 3, (/1.,2.,4./), (/1.,2.,4.,8./), & 3, (/2.,3.,4./), (/1.,3.,6.,8./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'F: 3 layer to 4 with vanished top/botton', & + fail = test_interp(verbose, 'F: 3 layer to 4 with vanished top/botton', & 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,5.,0./), (/mv,1.,3.,8.,mv/) ) + 4, (/0.,2.,5.,0./), (/0.,1.,3.,8.,0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'Fs: 3 layer to 4 with vanished top/botton (shallow)', & + fail = test_interp(verbose, 'Fs: 3 layer to 4 with vanished top/botton (shallow)', & 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,4.,0./), (/mv,1.,3.,7.,mv/) ) + 4, (/0.,2.,4.,0./), (/0.,1.,3.,7.,0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_interp(v,mv,'Fd: 3 layer to 4 with vanished top/botton (deep)', & + fail = test_interp(verbose, 'Fd: 3 layer to 4 with vanished top/botton (deep)', & 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,6.,0./), (/mv,1.,3.,8.,mv/) ) + 4, (/0.,2.,6.,0./), (/0.,1.,3.,8.,0./) ) remapping_unit_tests = remapping_unit_tests .or. fail if (verbose) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' - fail = test_reintegrate(v,mv,'Identity: 3 layer', & + fail = test_reintegrate(verbose, 'Identity: 3 layer', & 3, (/1.,2.,3./), (/-5.,2.,1./), & 3, (/1.,2.,3./), (/-5.,2.,1./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'A: 3 layer to 2', & + fail = test_reintegrate(verbose, 'A: 3 layer to 2', & 3, (/2.,2.,2./), (/-5.,2.,1./), & 2, (/3.,3./), (/-4.,2./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'A: 3 layer to 2 (deep)', & + fail = test_reintegrate(verbose, 'A: 3 layer to 2 (deep)', & 3, (/2.,2.,2./), (/-5.,2.,1./), & 2, (/3.,4./), (/-4.,2./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'A: 3 layer to 2 (shallow)', & + fail = test_reintegrate(verbose, 'A: 3 layer to 2 (shallow)', & 3, (/2.,2.,2./), (/-5.,2.,1./), & 2, (/3.,2./), (/-4.,1.5/) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'B: 3 layer to 4 with vanished top/bottom', & + fail = test_reintegrate(verbose, 'B: 3 layer to 4 with vanished top/bottom', & 3, (/2.,2.,2./), (/-5.,2.,1./), & 4, (/0.,3.,3.,0./), (/0.,-4.,2.,0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'C: 3 layer to 4 with vanished top//middle/bottom', & + fail = test_reintegrate(verbose, 'C: 3 layer to 4 with vanished top//middle/bottom', & 3, (/2.,2.,2./), (/-5.,2.,1./), & 5, (/0.,3.,0.,3.,0./), (/0.,-4.,0.,2.,0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'D: 3 layer to 3 (vanished)', & + fail = test_reintegrate(verbose, 'D: 3 layer to 3 (vanished)', & 3, (/2.,2.,2./), (/-5.,2.,1./), & 3, (/0.,0.,0./), (/0.,0.,0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3', & + fail = test_reintegrate(verbose, 'D: 3 layer (vanished) to 3', & 3, (/0.,0.,0./), (/-5.,2.,1./), & - 3, (/2.,2.,2./), (/mv, mv, mv/) ) + 3, (/2.,2.,2./), (/0., 0., 0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & + fail = test_reintegrate(verbose, 'D: 3 layer (vanished) to 3 (vanished)', & 3, (/0.,0.,0./), (/-5.,2.,1./), & - 3, (/0.,0.,0./), (/mv, mv, mv/) ) + 3, (/0.,0.,0./), (/0., 0., 0./) ) remapping_unit_tests = remapping_unit_tests .or. fail - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & + fail = test_reintegrate(verbose, 'D: 3 layer (vanished) to 3 (vanished)', & 3, (/0.,0.,0./), (/0.,0.,0./), & - 3, (/0.,0.,0./), (/mv, mv, mv/) ) + 3, (/0.,0.,0./), (/0., 0., 0./) ) remapping_unit_tests = remapping_unit_tests .or. fail if (.not. remapping_unit_tests) write(stdout,*) 'Pass' @@ -1717,11 +1715,10 @@ logical function test_answer(verbose, n, u, u_true, label, tol) end function test_answer !> Returns true if a test of interpolate_column() produces the wrong answer -logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, ndest, h_dest, u_true) +logical function test_interp(verbose, msg, nsrc, h_src, u_src, ndest, h_dest, u_true) logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: missing_value !< Value to indicate missing data - character(len=*), intent(in) :: msg !< Message to label test - integer, intent(in) :: nsrc !< Number of source cells + character(len=*), intent(in) :: msg !< Message to label test + integer, intent(in) :: nsrc !< Number of source cells real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces [A] integer, intent(in) :: ndest !< Number of destination cells @@ -1733,7 +1730,7 @@ logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, nd real :: error ! Interpolate from src to dest - call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) + call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest) test_interp = .false. do k=1,ndest+1 @@ -1755,9 +1752,8 @@ logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, nd end function test_interp !> Returns true if a test of reintegrate_column() produces the wrong answer -logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_src, ndest, h_dest, uh_true) +logical function test_reintegrate(verbose, msg, nsrc, h_src, uh_src, ndest, h_dest, uh_true) logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: missing_value !< Value to indicate missing data [A H] character(len=*), intent(in) :: msg !< Message to label test integer, intent(in) :: nsrc !< Number of source cells real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] @@ -1771,7 +1767,7 @@ logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_s real :: error ! Interpolate from src to dest - call reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) + call reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, uh_dest) test_reintegrate = .false. do k=1,ndest diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index eae498f5cb..05bd8aeed0 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -527,7 +527,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (h_target(i_lo,j,:) + h_target(i_hi,j,:)) call reintegrate_column(nz_src, h_src, field(I1,j,:), & - nz_dest, h_dest, 0., reintegrated_field(I1,j,:)) + nz_dest, h_dest, reintegrated_field(I1,j,:)) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then @@ -542,7 +542,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (h_target(i,j_lo,:) + h_target(i,j_hi,:)) call reintegrate_column(nz_src, h_src, field(i,J1,:), & - nz_dest, h_dest, 0., reintegrated_field(i,J1,:)) + nz_dest, h_dest, reintegrated_field(i,J1,:)) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -555,7 +555,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered h_src(:) = h(i,j,:) h_dest(:) = h_target(i,j,:) call reintegrate_column(nz_src, h_src, field(i,j,:), & - nz_dest, h_dest, 0., reintegrated_field(i,j,:)) + nz_dest, h_dest, reintegrated_field(i,j,:)) enddo enddo else @@ -608,7 +608,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) call interpolate_column(nz_src, h_src, field(I1,j,:), & - nz_dest, h_dest, 0., interpolated_field(I1,j,:)) + nz_dest, h_dest, interpolated_field(I1,j,:)) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then @@ -623,7 +623,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) call interpolate_column(nz_src, h_src, field(i,J1,:), & - nz_dest, h_dest, 0., interpolated_field(i,J1,:)) + nz_dest, h_dest, interpolated_field(i,J1,:)) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -636,7 +636,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = h(i,j,:) h_dest(:) = remap_cs%h(i,j,:) call interpolate_column(nz_src, h_src, field(i,j,:), & - nz_dest, h_dest, 0., interpolated_field(i,j,:)) + nz_dest, h_dest, interpolated_field(i,j,:)) enddo enddo else diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 1bd5500023..f26395c119 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -697,7 +697,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ enddo ! remap flux to h_vel (native grid) - call reintegrate_column(nk, dz_top(:), F_layer_z(:), ke, h_vel(:), 0.0, F_layer(:)) + call reintegrate_column(nk, dz_top(:), F_layer_z(:), ke, h_vel(:), F_layer(:)) ! used to avoid fluxes below hbl if (CS%linear) then diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index ab37b87f17..d42355f245 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -13,7 +13,6 @@ module MOM_offline_aux use MOM_grid, only : ocean_grid_type use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER use MOM_opacity, only : optics_type -use MOM_remapping, only : reintegrate_column use MOM_time_manager, only : time_type, operator(-) use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : vertvisc_type From b52593282f0df4c97fd5fb6d73ca2dc24630230b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Oct 2022 15:31:52 -0400 Subject: [PATCH 011/213] Add check_remapped_values Added the new subroutine check_remapped_values with the duplicative error checking code in remapping_core_h and remapping_core_w, both to reduce code volume and promote code coverage, and to make the substance of these two routines easier to follow. All answers are bitwise identical. --- src/ALE/MOM_remapping.F90 | 166 +++++++++++++++++--------------------- 1 file changed, 76 insertions(+), 90 deletions(-) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index ad8fe48fbf..fa79c50c3c 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -172,17 +172,12 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edg !! cells in the source grid where this is true. ! Local variables - integer :: iMethod real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial [A] real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial [A H-1] - real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial [A] - real :: h0tot, h0err ! Sum of source cell widths and round-off error in this sum [H] - real :: h1tot, h1err ! Sum of target cell widths and round-off error in this sum [H] - real :: u0tot, u0err ! Integrated values on the source grid and round-off error in this sum [H A] - real :: u1tot, u1err ! Integrated values on the target grid and round-off error in this sum [H A] - real :: u0min, u0max, u1min, u1max ! Extrema of values on the two grids [A] - real :: uh_err ! Difference in the total amounts on the two grids [H A] + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial reconstructions [A] + real :: uh_err ! A bound on the error in the sum of u*h, as estimated by the remapping code [A H] real :: hNeglect, hNeglect_edge ! Negligibly small cell widths in the same units as h0 [H] + integer :: iMethod ! An integer indicating the integration method used integer :: k hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect @@ -197,43 +192,8 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edg call remap_via_sub_cells( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, h1, iMethod, & CS%force_bounds_in_subcell, u1, uh_err ) - if (CS%check_remapping) then - ! Check errors and bounds - call measure_input_bounds( n0, h0, u0, ppoly_r_E, h0tot, h0err, u0tot, u0err, u0min, u0max ) - call measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) - if (iMethod<5) then ! We except PQM until we've debugged it - if ( (abs(u1tot-u0tot)>(u0err+u1err)+uh_err .and. abs(h1tot-h0tot)u0max) ) then - write(0,*) 'iMethod = ',iMethod - write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) & - write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' - write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & - write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' - write(0,*) 'U: u0min=',u0min,'u1min=',u1min - if (u1minn0) then - write(0,'(i3,96x,1p2e24.16)') k,h1(k),u1(k) - else - write(0,'(i3,1p4e24.16)') k,h0(k),ppoly_r_E(k,1),u0(k),ppoly_r_E(k,2) - endif - enddo - write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' - do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) - enddo - call MOM_error( FATAL, 'MOM_remapping, remapping_core_h: '//& - 'Remapping result is inconsistent!' ) - endif - endif ! method<5 - endif + if (CS%check_remapping) call check_remapped_values(n0, h0, u0, ppoly_r_E, CS%degree, ppoly_r_coefs, & + n1, h1, u1, iMethod, uh_err, "remapping_core_h") end subroutine remapping_core_h @@ -256,16 +216,11 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed ! Local variables real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial [A] real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial [A H-1] - real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial [A] - real :: h0tot, h1tot ! The total thicknesses of the source and target grids [H] - real :: h0err, h1err ! Magnitude of round-off errors in h0tot and h1tot [H] - real :: u0tot, u1tot ! Column integrated values on the source and target grids [H A] - real :: u0err, u1err ! Magnitude of round-off errors in u0tot and u1tot [H A] - real :: u0min, u0max, u1min, u1max ! Extrema of values on the source and target grids [A] - real :: uh_err ! Estimate of bound on error in sum of u*h [A H] + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial reconstructions [A] real, dimension(n1) :: h1 !< Cell widths on target grid [H] + real :: uh_err ! A bound on the error in the sum of u*h, as estimated by the remapping code [A H] real :: hNeglect, hNeglect_edge ! Negligibly small thicknesses [H] - integer :: iMethod + integer :: iMethod ! An integer indicating the integration method used integer :: k hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect @@ -290,43 +245,8 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed ! call remapByDeltaZ( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, dx, iMethod, u1, hNeglect ) ! call remapByProjection( n0, h0, u0, CS%ppoly_r, n1, h1, iMethod, u1, hNeglect ) - if (CS%check_remapping) then - ! Check errors and bounds - call measure_input_bounds( n0, h0, u0, ppoly_r_E, h0tot, h0err, u0tot, u0err, u0min, u0max ) - call measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) - if (iMethod<5) then ! We except PQM until we've debugged it - if ( (abs(u1tot-u0tot)>(u0err+u1err)+uh_err .and. abs(h1tot-h0tot)u0max) ) then - write(0,*) 'iMethod = ',iMethod - write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) & - write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' - write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & - write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' - write(0,*) 'U: u0min=',u0min,'u1min=',u1min - if (u1minn0) then - write(0,'(i3,96x,1p2e24.16)') k,h1(k),u1(k) - else - write(0,'(i3,1p4e24.16)') k,h0(k),ppoly_r_E(k,1),u0(k),ppoly_r_E(k,2) - endif - enddo - write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' - do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) - enddo - call MOM_error( FATAL, 'MOM_remapping, remapping_core_w: '//& - 'Remapping result is inconsistent!' ) - endif - endif ! method<5 - endif + if (CS%check_remapping) call check_remapped_values(n0, h0, u0, ppoly_r_E, CS%degree, ppoly_r_coefs, & + n1, h1, u1, iMethod, uh_err, "remapping_core_w") end subroutine remapping_core_w @@ -1171,6 +1091,72 @@ real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefs, method, i0, x end function average_value_ppoly +!> This subroutine checks for sufficient consistence in the extrema and total amounts on the old +!! and new grids. +subroutine check_remapped_values(n0, h0, u0, ppoly_r_E, deg, ppoly_r_coefs, & + n1, h1, u1, iMethod, uh_err, caller) + integer, intent(in) :: n0 !< Number of cells on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] + real, dimension(n0,2), intent(in) :: ppoly_r_E !< Edge values of polynomial fits [A] + integer, intent(in) :: deg !< Degree of the piecewise polynomial reconstrution + real, dimension(n0,deg+1), intent(in) :: ppoly_r_coefs !< Coefficients of the piecewise + !! polynomial reconstructions [A] + integer, intent(in) :: n1 !< Number of cells on target grid + real, dimension(n1), intent(in) :: h1 !< Cell widths on target grid [H] + real, dimension(n1), intent(in) :: u1 !< Cell averages on target grid [A] + integer, intent(in) :: iMethod !< An integer indicating the integration method used + real, intent(in) :: uh_err !< A bound on the error in the sum of u*h as + !! estimated by the remapping code [H A] + character(len=*), intent(in) :: caller !< The name of the calling routine. + + ! Local variables + real :: h0tot, h0err ! Sum of source cell widths and round-off error in this sum [H] + real :: h1tot, h1err ! Sum of target cell widths and round-off error in this sum [H] + real :: u0tot, u0err ! Integrated values on the source grid and round-off error in this sum [H A] + real :: u1tot, u1err ! Integrated values on the target grid and round-off error in this sum [H A] + real :: u0min, u0max, u1min, u1max ! Extrema of values on the two grids [A] + integer :: k + + ! Check errors and bounds + call measure_input_bounds( n0, h0, u0, ppoly_r_E, h0tot, h0err, u0tot, u0err, u0min, u0max ) + call measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) + + if (iMethod<5) return ! We except PQM until we've debugged it + + if ( (abs(u1tot-u0tot)>(u0err+u1err)+uh_err .and. abs(h1tot-h0tot)u0max) ) then + write(0,*) 'iMethod = ',iMethod + write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + write(0,*) 'U: u0min=',u0min,'u1min=',u1min + if (u1minn0) then + write(0,'(i3,96x,1p2e24.16)') k,h1(k),u1(k) + else + write(0,'(i3,1p4e24.16)') k,h0(k),ppoly_r_E(k,1),u0(k),ppoly_r_E(k,2) + endif + enddo + write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' + do k = 1, n0 + write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) + enddo + call MOM_error( FATAL, 'MOM_remapping, '//trim(caller)//': '//& + 'Remapping result is inconsistent!' ) + endif + +end subroutine check_remapped_values + !> Measure totals and bounds on source grid subroutine measure_input_bounds( n0, h0, u0, edge_values, h0tot, h0err, u0tot, u0err, u0min, u0max ) integer, intent(in) :: n0 !< Number of cells on source grid From bc01d95022782562c3cf5857e5771dd332e40d58 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 31 Aug 2022 16:59:04 -0400 Subject: [PATCH 012/213] gitlab-ci: Adds (command-line) tool to simplify .gitlab-ci.yml - Adds `.gitlab/pipeline-ci-tool.sh` to enact most of the stages of the gitlab CI pipeline - enables interactive/command-line reproduction of the pipeline - `.gitlab/pipeline-ci-tool.sh` is documented in .gitlab/README.md with instructions on how to use at the command line and what each function is doing - All commands formerly in .gitlab-ci.yml are now one-line invocations of `.gitlab/pipeline-ci-tool.sh` so .gitlab-ci.yml is now considerably smaller and easier to read with statements like `.gitlab/pipeline-ci-tool.sh mrs-compile debug_gnu` or `.gitlab/pipeline-ci-tool.sh check-params gnu` - Previously, all results were compared again the stored regression answers. This meant that any error (e.g. layout) would show up as a fail of all types. We use the regression answers to check the repro-symmetric mode and then compare everything else to repro-symmetric or other results as appropriate. This allows us to distinguish between types of errors. The GH actions are doing it this way, and we originally did this in the first forms of the pipeline, but in the last re-factor I lazily switched to using the regression answers for everything. --- .gitlab-ci.yml | 243 +++++---------- .gitlab/README.md | 148 ++++++++++ .gitlab/mom6-ci-run-gnu-script.sh | 2 +- .gitlab/mom6-ci-run-intel-script.sh | 2 +- .gitlab/mom6-ci-run-pgi-script.sh | 2 +- .gitlab/pipeline-ci-tool.sh | 444 ++++++++++++++++++++++++++++ 6 files changed, 672 insertions(+), 169 deletions(-) create mode 100644 .gitlab/README.md create mode 100755 .gitlab/pipeline-ci-tool.sh diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 496a578c91..6a622f55cc 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,124 +6,71 @@ stages: - cleanup # JOB_DIR points to a persistent working space used for most stages in this pipeline but -# it is unique to this pipeline. +# that is unique to this pipeline. # We use the "fetch" strategy to speed up the startup of stages variables: JOB_DIR: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/builds/$CI_PIPELINE_ID" GIT_STRATEGY: fetch -# Start all stages in $JOB_DIR/.../MOM6-examples -# Exception: for "setup" stages MOM6-examples has not yet been cloned so the stage starts in $JOB_DIR +# Always eport value of $JOB_DIR before_script: - - echo -e "\e[0Ksection_start:`date +%s`:dir_stuff[collapsed=true]\r\e[0KChanging directories to $JOB_DIR" - echo Job directory set to $JOB_DIR - - mkdir -p $JOB_DIR - - cd $JOB_DIR - - test -d Gaea-stats-MOM6-examples/MOM6-examples && cd Gaea-stats-MOM6-examples/MOM6-examples - - pwd - - echo -e "\e[0Ksection_end:`date +%s`:dir_stuff\r\e[0K" # Test that merge with dev/gfdl works. -merge: +p:merge: stage: setup tags: - ncrc4 script: - - cd $CI_PROJECT_DIR - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl # Setup the persistent JOB_DIR for all subsequent stages # -# This basically setups up a complete tree much as a user would work -# EXCEPT that src/MOM6 is cloned from a file system -clone: +# This basically setups up a complete tree much as a user would in their workflow +p:clone: stage: setup tags: - ncrc4 - before_script: - - echo -e "\e[0Ksection_start:`date +%s`:dir_stuff[collapsed=true]\r\e[0KChanging directories to $JOB_DIR" - - cd $CI_PROJECT_DIR - - git submodule init ; git submodule update - - echo Job directory set to $JOB_DIR - - mkdir -p $JOB_DIR - - cd $JOB_DIR - - test -d Gaea-stats-MOM6-examples && rm -rf Gaea-stats-MOM6-examples # In case we are re-running this stage - - pwd - - echo -e "\e[0Ksection_end:`date +%s`:dir_stuff\r\e[0K" - script: - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCloning repository tree" - - git clone https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git - - cd Gaea-stats-MOM6-examples - - git submodule update --init - - cd MOM6-examples - - git checkout dev/gfdl - - git submodule init - - git submodule set-url src/MOM6 $CI_PROJECT_DIR/.git # Easiest way to get MOM6 source to be tested - - git submodule update --recursive --jobs 8 - - (cd src/MOM6 ; git checkout $CI_COMMIT_SHA ; git submodule update --recursive --init) # Get commit to be tested - - make -f tools/MRS/Makefile.clone clone_gfdl -j # Extras and link to datasets - - bash tools/MRS/generate_manifest.sh . tools/MRS/excluded-expts.txt > manifest.mk - - mkdir -p results - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + script: + - .gitlab/pipeline-ci-tool.sh create-job-dir +#.gitlab/pipeline-ci-tool.sh clean-job-dir # Make work spaces for running simultaneously in parallel jobs # # Each work space is a clone of MOM6-examples with symbolic links for the build and data directories # so they can share executables which can run simultaneously without interfering with each other -work-space:pgi: +s:work-space:pgi: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-pgi-MOM6-examples - - cd tmp-pgi-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space pgi -work-space:intel: +s:work-space:intel: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-intel-MOM6-examples - - cd tmp-intel-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space intel -work-space:gnu: +s:work-space:gnu: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-gnu-MOM6-examples - - cd tmp-gnu-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space gnu -work-space:gnu-restarts: +s:work-space:gnu-restarts: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-gnu-restarts-MOM6-examples - - cd tmp-gnu-restarts-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space gnu-rst # Compile executables # @@ -132,140 +79,97 @@ work-space:gnu-restarts: compile:pgi:repro: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_pgi" - - time make -f tools/MRS/Makefile.build repro_pgi -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile repro_pgi compile:intel:repro: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_intel" - - time make -f tools/MRS/Makefile.build repro_intel -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile repro_intel compile:gnu:repro: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_gnu" - - time make -f tools/MRS/Makefile.build repro_gnu -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - echo -e "\e[0Ksection_start:`date +%s`:compile2[collapsed=true]\r\e[0KCompiling target static_gnu" - - time make -f tools/MRS/Makefile.build static_gnu -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile2\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile repro_gnu mrs-compile static_gnu compile:gnu:debug: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile2[collapsed=true]\r\e[0KCompiling target debug_gnu" - - time make -f tools/MRS/Makefile.build debug_gnu -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile debug_gnu compile:gnu:ocean-only-nolibs: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ocean-only no-libs" - - mkdir -p build-ocean-only-nolibs - - cd build-ocean-only-nolibs - - make -f ../tools/MRS/Makefile.build ./gnu/env BUILD=. -s - - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 - - sed -i '/FMS1\/.*\/test_/d' path_names - - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names - - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh nolibs-ocean-only-compile gnu compile:gnu:ice-ocean-nolibs: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ice-ocean-SIS2 no-libs" - - mkdir -p build-ice-ocean-SIS2-nolibs - - cd build-ice-ocean-SIS2-nolibs - - make -f ../tools/MRS/Makefile.build ./gnu/env BUILD=. -s - - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} - - sed -i '/FMS1\/.*\/test_/d' path_names - - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names - - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh nolibs-ocean-ice-compile gnu # Runs -# -# The main "run" stage uses the script .gitlab/mom6-ci-run-script.sh run:pgi: stage: run - needs: ["work-space:pgi","compile:pgi:repro"] + needs: ["s:work-space:pgi","compile:pgi:repro"] tags: - ncrc4 script: - - cd tmp-pgi-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-pgi-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-pgi-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-PGI-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite pgi SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-pgi-SNL || ( echo Batch job did not complete ; exit 911 ) run:intel: stage: run - needs: ["work-space:intel","compile:intel:repro"] + needs: ["s:work-space:intel","compile:intel:repro"] tags: - ncrc4 script: - - echo 911 - - cd tmp-intel-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-intel-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-intel-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-INTEL-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite intel SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-intel-SNL || ( echo Batch job did not complete ; exit 911 ) run:gnu: stage: run - needs: ["work-space:gnu","compile:gnu:repro","compile:gnu:debug"] + needs: ["s:work-space:gnu","compile:gnu:repro","compile:gnu:debug"] tags: - ncrc4 script: - - cd tmp-gnu-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-gnu-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-gnu-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-GNU-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu SNLDT && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-SNLDT || ( echo Batch job did not complete ; exit 911 ) run:gnu-restarts: stage: run - needs: ["work-space:gnu","compile:gnu:repro"] + needs: ["s:work-space:gnu-restarts","compile:gnu:repro"] tags: - ncrc4 script: - - echo 911 - - cd tmp-gnu-restarts-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-gnu-restarts-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait mom6-ci-run-gnu-restarts-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-GNU-RESTARTS-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu R && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-R || ( echo Batch job did not complete ; exit 911 ) -# These "run" stages replace the "before_script" and so start in the transient work-space provided by gitlab +# GH/autoconf tests (duplicates the GH actions tests) +# +# These stages replace the "before_script" and so start in the transient work-space provided by gitlab. # We work here to avoid collisions with parallel jobs -gnu.testing: - stage: run +actions:gnu: + stage: tests needs: [] tags: - ncrc4 @@ -281,10 +185,10 @@ gnu.testing: - make -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || cat log.$CI_JOB_ID + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || ( cat log.$CI_JOB_ID ; exit 911 ) -intel.testing: - stage: run +actions:intel: + stage: tests needs: [] tags: - ncrc4 @@ -300,7 +204,7 @@ intel.testing: - make -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || cat log.$CI_JOB_ID + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh && make test || ( cat log.$CI_JOB_ID ; exit 911 ) # Tests # @@ -313,7 +217,7 @@ t:pgi:symmetric: tags: - ncrc4 script: - - ( cd results/pgi_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats pgi S t:pgi:non-symmetric: stage: tests @@ -321,7 +225,7 @@ t:pgi:non-symmetric: tags: - ncrc4 script: - - ( cd results/pgi_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats pgi N t:pgi:layout: stage: tests @@ -329,7 +233,7 @@ t:pgi:layout: tags: - ncrc4 script: - - ( cd results/pgi_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats pgi L t:pgi:params: stage: tests @@ -337,7 +241,7 @@ t:pgi:params: tags: - ncrc4 script: - - ( cd results/pgi_params/ ; md5sum `find * -type f` ) | md5sum -c + - .gitlab/pipeline-ci-tool.sh check-params pgi allow_failure: true t:intel:symmetric: @@ -346,7 +250,7 @@ t:intel:symmetric: tags: - ncrc4 script: - - ( cd results/intel_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats intel S t:intel:non-symmetric: stage: tests @@ -354,7 +258,7 @@ t:intel:non-symmetric: tags: - ncrc4 script: - - ( cd results/intel_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats intel N t:intel:layout: stage: tests @@ -362,7 +266,7 @@ t:intel:layout: tags: - ncrc4 script: - - ( cd results/intel_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats intel L t:intel:params: stage: tests @@ -370,7 +274,7 @@ t:intel:params: tags: - ncrc4 script: - - ( cd results/intel_params/ ; md5sum `find * -type f` ) | md5sum -c + - .gitlab/pipeline-ci-tool.sh check-params intel allow_failure: true t:gnu:symmetric: @@ -379,7 +283,7 @@ t:gnu:symmetric: tags: - ncrc4 script: - - ( cd results/gnu_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu S t:gnu:non-symmetric: stage: tests @@ -387,7 +291,7 @@ t:gnu:non-symmetric: tags: - ncrc4 script: - - ( cd results/gnu_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu N t:gnu:layout: stage: tests @@ -395,7 +299,7 @@ t:gnu:layout: tags: - ncrc4 script: - - ( cd results/gnu_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu L t:gnu:static: stage: tests @@ -403,7 +307,7 @@ t:gnu:static: tags: - ncrc4 script: - - ( cd results/gnu_all_static/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu T t:gnu:symmetric-debug: stage: tests @@ -411,7 +315,7 @@ t:gnu:symmetric-debug: tags: - ncrc4 script: - - ( cd results/gnu_ocean_only_debug/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu D t:gnu:restart: stage: tests @@ -419,9 +323,7 @@ t:gnu:restart: tags: - ncrc4 script: - - cd tmp-gnu-restarts-MOM6-examples - - ( cd ../results/gnu_restarts ; tar cf - * ) | tar xf - # NOTE this unpacks in tmp-gnu-restarts-MOM6-examples (not a new directory) - - make -f tools/MRS/Makefile.restart restart_gnu_ocean_only restart_gnu_ice_ocean_SIS2 -s -k + - .gitlab/pipeline-ci-tool.sh check-stats gnu R t:gnu:params: stage: tests @@ -429,7 +331,16 @@ t:gnu:params: tags: - ncrc4 script: - - ( cd results/gnu_params/ ; md5sum `find * -type f` ) | md5sum -c + - .gitlab/pipeline-ci-tool.sh check-params gnu + allow_failure: true + +t:gnu:diags: + stage: tests + needs: ["run:gnu"] + tags: + - ncrc4 + script: + - .gitlab/pipeline-ci-tool.sh check-diags gnu allow_failure: true # We cleanup ONLY if the preceding stages were completed successfully diff --git a/.gitlab/README.md b/.gitlab/README.md new file mode 100644 index 0000000000..6e11900f9e --- /dev/null +++ b/.gitlab/README.md @@ -0,0 +1,148 @@ +# CI script pipeline-ci-tool.sh + +pipeline-ci-tool.sh contains functions corresponding to each job within the gitlab CI pipeline for MOM6 at GFDL, specifically on the gaea HPC. +Each function can be run by a parser function so that the functions can be invoked from the command line or a shell. +Some functions take arguments. +Encapsulating the job commands in a function allows us to develop/debug the pipeline by issuing the same, relatively short, commands at the command line. + +pipeline-ci-tool.sh relies on three environment variables to execute. They are mandatory. + - JOB_DIR is a scratch location that will be created and populated + - CI_PROJECT_DIR is normally set by gitlab and will point to the working directory where MOM6 is cloned + - CI_COMMIT_SHA is the commit of MOM6 to be tested + +To use pipeline-ci-tool.sh interactively from an existing MOM6 clone, you could use + `JOB_DIR=tmp CI_PROJECT_DIR=. CI_COMMIT_SHA=`git rev-parse HEAD` .gitlab/pipeline-ci-tool.sh ...` +This will use the HEAD commit in the current working dir and setup an independent test suite under tmp/. + +## Usage + `pipeline-ci-tool.sh FUNCTION [-x|+x] [-n|+n] [ARG1] [ARG2] [...]` + `pipeline-ci-tool.sh FUNCTION [-x|+x] [-n|+n] [ARG1] [ARG2] [[-x|+x] [-n|+n] FUNCTION [ARG1] [ARG2] [...]] [...]` + +FUNCTION can be one of + - `create-job-dir` : Create a "job directory" using the environment variable JOB_DIR. This is a where all the compilation and running takes place. + - `clean-job-dir` : Not used by .gitlab-ci.yml but useful for resetting an interactive session. + - `copy-test-space LABEL` : Within $JOB_DIR, clones MOM6-examples to tmp-MOM6-examples-LABEL to use as a workspace for tests + - `mrs-compile TARGET` : Invokes tools/MRS/Makefile.build to build MODE_VENDER. VENDER can be gnu, intel, or pgi. MODE can be repro, debug, static, etc. + - `nolibs-ocean-only-compile VENDER` : Compiles the "no libraries" executables. These are not used elsewhere in the CI but check we have no namespace problems. VENDER can be gnu, intel, or pgi. + - `run-suite VENDER CODE` : runs subsets of the MOM6-examples according to CODE using the VENDER executables. CODE is a string of the characters S (symmetric), N (non-symmetric), L (layout), D (debug), or R (restart), and if present executes the corresponding tests. + - `check-stats VENDER CODE` : check the stats files for the corresponding VENDOR/CODE resulting from run-suite + - `check-params VENDER CODE` : check the parameter documentation files for the corresponding VENDOR/CODE resulting from run-suite + - `check-diags VENDER CODE` : check the available diagnostics files for the corresponding VENDOR/CODE resulting from run-suite + +Options: + - `-x` : shows commands as they are executed. `+x` turns back to silent executions. You can precede each function as needed so that only commands from selected functions are shown. + - `-n` : for many function, disables all functionality and simply prints the banner that each sections was reached. `+n` turns the functions back on. + +## Correspondance to jobs in .gitlab-ci.yml + +The .gitlab-ci.yml jobs names and pipeline-ci-tool.sh commands are: + + clone: + `pipeline-ci-tool.sh create-job-dir` + + work-space:pgi: + `pipeline-ci-tool.sh copy-test-space pgi` + + work-space:intel: + `pipeline-ci-tool.sh copy-test-space intel` + + work-space:gnu: + `pipeline-ci-tool.sh copy-test-space gnu` + + work-space:gnu-restarts: + `pipeline-ci-tool.sh copy-test-space gnu-rst` + + compile:pgi:repro: + `pipeline-ci-tool.sh mrs-compile repro_pgi` + + compile:intel:repro: + `pipeline-ci-tool.sh mrs-compile repro_intel` + + compile:gnu:repro: + `pipeline-ci-tool.sh mrs-compile repro_gnu mrs-compile static_gnu` + + compile:gnu:debug: + `pipeline-ci-tool.sh mrs-compile debug_gnu` + + compile:gnu:ocean-only-nolibs: + `pipeline-ci-tool.sh nolibs-ocean-only-compile gnu` + + compile:gnu:ice-ocean-nolibs: + `pipeline-ci-tool.sh nolibs-ocean-ice-compile gnu` + + run:pgi: + `pipeline-ci-tool.sh run-suite pgi SNL` + + run:intel: + `pipeline-ci-tool.sh run-suite intel SNL` + + run:gnu: + `pipeline-ci-tool.sh run-suite gnu SNLD` + + run:gnu-restarts: + `pipeline-ci-tool.sh run-suite gnu R` + + t:pgi:symmetric: + `pipeline-ci-tool.sh check-stats pgi S` + + t:pgi:non-symmetric: + `pipeline-ci-tool.sh check-stats pgi N` + + t:pgi:layout: + `pipeline-ci-tool.sh check-stats pgi L` + + t:pgi:params: + `pipeline-ci-tool.sh check-params pgi S` + + t:intel:symmetric: + `pipeline-ci-tool.sh check-stats intel S` + + t:intel:non-symmetric: + `pipeline-ci-tool.sh check-stats intel N` + + t:intel:layout: + `pipeline-ci-tool.sh check-stats intel L` + + t:intel:params: + `pipeline-ci-tool.sh check-params intel S` + + t:gnu:symmetric: + `pipeline-ci-tool.sh check-stats gnu S` + + t:gnu:non-symmetric: + `pipeline-ci-tool.sh check-stats gnu N` + + t:gnu:layout: + `pipeline-ci-tool.sh check-stats gnu L` + + t:gnu:static: + `pipeline-ci-tool.sh check-stats gnu T` + + t:gnu:symmetric-debug: + `pipeline-ci-tool.sh check-stats gnu D` + + t:gnu:restart: + `pipeline-ci-tool.sh check-stats gnu R` + + t:gnu:params: + `pipeline-ci-tool.sh check-params gnu S` + + t:gnu:diags: + `pipeline-ci-tool.sh check-diags gnu S` + +### Duplicating the pipeline interactively + +You can run a sequence of commands as follows. The setup and compile phases of the CI pipeline can be summarized with +``` +pipeline-ci-tool.sh create-job-dir copy-test-space pgi copy-test-space intel copy-test-space gnu copy-test-space gnu-rst mrs-compile repro_pgi mrs-compile repro_intel mrs-compile repro_gnu mrs-compile static_gnu mrs-compile debug_gnu nolibs-ocean-only-compile gnu nolibs-ocean-ice-compile gnu +``` + +The run stage (works on compute nodes only) can be summarized with: +``` +pipeline-ci-tool.sh run-suite pgi SNL run-suite intel SNL run-suite gnu SNLDT run-suite gnu R +``` + +The test stage is summarized by: +``` +pipeline-ci-tool.sh check-stats pgi S check-stats pgi N check-stats pgi L check-params pgi S check-stats intel S check-stats intel N check-stats intel L check-params intel S check-stats gnu S check-stats gnu N check-stats gnu L check-stats gnu T check-stats gnu D check-stats gnu R check-params gnu S check-diags gnu S +``` diff --git a/.gitlab/mom6-ci-run-gnu-script.sh b/.gitlab/mom6-ci-run-gnu-script.sh index 82e37abc5e..8577eff6d2 100644 --- a/.gitlab/mom6-ci-run-gnu-script.sh +++ b/.gitlab/mom6-ci-run-gnu-script.sh @@ -34,7 +34,7 @@ set -v section_start gnu_all_sym "Running symmetric gnu" time make -f tools/MRS/Makefile.run gnu_all -s -j tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_all_sym -xf - -tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/gnu_params -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/gnu_params -xf - check_for_core_files section_end diff --git a/.gitlab/mom6-ci-run-intel-script.sh b/.gitlab/mom6-ci-run-intel-script.sh index c5a361a202..875d60c191 100644 --- a/.gitlab/mom6-ci-run-intel-script.sh +++ b/.gitlab/mom6-ci-run-intel-script.sh @@ -34,7 +34,7 @@ set -v section_start intel_all_sym "Running symmetric intel" time make -f tools/MRS/Makefile.run intel_all -s -j tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/intel_all_sym -xf - -tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/intel_params -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/intel_params -xf - check_for_core_files section_end diff --git a/.gitlab/mom6-ci-run-pgi-script.sh b/.gitlab/mom6-ci-run-pgi-script.sh index 98ba9a08c3..27216e4a9f 100644 --- a/.gitlab/mom6-ci-run-pgi-script.sh +++ b/.gitlab/mom6-ci-run-pgi-script.sh @@ -34,7 +34,7 @@ set -v section_start pgi_all_sym "Running symmetric pgi" time make -f tools/MRS/Makefile.run pgi_all -s -j tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/pgi_all_sym -xf - -tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/pgi_params -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/pgi_params -xf - check_for_core_files section_end diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh new file mode 100755 index 0000000000..e23d64523d --- /dev/null +++ b/.gitlab/pipeline-ci-tool.sh @@ -0,0 +1,444 @@ +#!/bin/bash + +# Environment variables set by gitlab (the CI environment) +if [ -z $JOB_DIR ]; then + echo Environment variable "$"JOB_DIR should be defined to point to a unique directory for these scripts to use. + echo '$JOB_DIR is derived from $CI_PIPELINE_ID in MOM6/.gitlab-ci.yml' + echo 'To use interactively try:' + echo ' JOB_DIR=tmp' $0 $@ + exit 911 +fi +if [ -z $CI_PROJECT_DIR ]; then + echo Environment variable "$"CI_PROJECT_DIR should be defined and point to where gitlab has cloned the MOM6 repository for this pipeline. + echo 'To use interactively try:' + echo ' CI_PROJECT_DIR=.' $0 $@ + exit 911 +else + CI_PROJECT_DIR=`realpath $CI_PROJECT_DIR` +fi +if [ -z $CI_COMMIT_SHA ]; then + echo Environment variable "$"CI_COMMIT_SHA should be defined and indicate the MOM6 commit to used in this pipeline. + echo 'To use interactively try:' + echo ' CI_COMMIT_SHA=`git rev-parse HEAD`' $0 $@ + exit 911 +fi + +# Use CI=true to enable the gitlab folding + +set -e # Stop if we encounter an error + +# Environment variables that can be set outside +STATS_REPO_URL="${STATS_REPO_URL:-https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git}" +STATS_REPO_BRANCH="${STATS_REPO_BRANCH:-dev/gfdl}" +CONFIGS_DIR="${CONFIGS_DIR:-MOM6-examples}" +CONFIGS_REPO_BRANCH="${CONFIGS_REPO_BRANCH:-$STATS_REPO_BRANCH}" + +# Global variables derived from the above +DRYRUN= +STATS_REPO=$(basename $STATS_REPO_URL) +STATS_REPO_DIR=$(basename $STATS_REPO .git) + +# Static variables +RED=$'\033[1;31m' +GRN=$'\033[1;32m' +OFF=$'\e[m' + +# Print the start of a fold in the log +section-start () { + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" +} + +# Print the start of a fold in the log but not collapsed +section-start-open () { + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=false]\r\e[0K$2" +} + +# Print the end of a fold in the log +section-end () { + echo -e "\e[0Ksection_end:`date +%s`:$1\r\e[0K" +} + +# Create $JOB_DIR and clean out any prior work-spaces +# Location: run in MOM6 directory +clean-job-dir () { + section-start clean-job-dir "Cleaning $JOB_DIR directory" + if [ ! $DRYRUN ] ; then + #NOT USED? cd $CI_PROJECT_DIR + #NOT USED? git submodule init ; git submodule update + echo Job directory set to $JOB_DIR + mkdir -p $JOB_DIR + cd $JOB_DIR + test -d $STATS_REPO_DIR && rm -rf $STATS_REPO_DIR # In case we are re-running this stage + fi + section-end clean-job-dir +} + +# Create the full work space starting at the regression repository (usually Gaea-stats-MOM6-examples) +# Location: run in MOM6 directory +create-job-dir () { + section-start create-job-dir "Creating and populating $JOB_DIR" + if [ ! $DRYRUN ] ; then + mkdir -p $JOB_DIR + cd $JOB_DIR + git clone $STATS_REPO_URL $STATS_REPO_DIR + cd $STATS_REPO_DIR + git checkout $STATS_REPO_BRANCH + git submodule update --init + cd $CONFIGS_DIR + git checkout $CONFIGS_REPO_BRANCH + git submodule init + git submodule set-url src/MOM6 $CI_PROJECT_DIR/.git + git submodule update --recursive --jobs 8 + (cd src/MOM6 ; git checkout $CI_COMMIT_SHA) # Get commit to be tested + (cd src/MOM6 ; git submodule update --recursive --init) + make -f tools/MRS/Makefile.clone clone_gfdl -j # Extras and link to datasets + bash tools/MRS/generate_manifest.sh . tools/MRS/excluded-expts.txt > manifest.mk + mkdir -p results + fi + section-end create-job-dir +} + +# Create a copy of the configurations working directory +# Location: run in MOM6 directory +copy-test-space () { + if [ -z $1 ]; then echo "copy-test-space needs an argument" ; exit 911 ; fi + section-start copy-test-space-$1 "Copying $CONFIGS_DIR for $1" + if [ ! $DRYRUN ] ; then + COPIED_DIR=tmp-$CONFIGS_DIR-$1 + cd $JOB_DIR/$STATS_REPO_DIR + git clone -s $CONFIGS_DIR/.git $COPIED_DIR + cd $COPIED_DIR + ln -s ../$CONFIGS_DIR/{build,results,.datasets} . + cp ../$CONFIGS_DIR/manifest.mk . + fi + section-end copy-test-space-$1 +} + +# Build a group of executables using the tools/MRS/Makefile.build template +# Location: run in MOM6 directory +mrs-compile () { + if [ -z $1 ]; then echo "mrs-compile needs an argument" ; exit 911 ; fi + section-start mrs-compile-$1 "Compiling target $1" + if [ ! $DRYRUN ] ; then + cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + time make -f tools/MRS/Makefile.build $1 -s -j + fi + section-end mrs-compile-$1 +} + +# Build an ocean-only executable without intermediate libraries +# Location: run in MOM6 directory +nolibs-ocean-only-compile () { + if [ -z $1 ]; then echo "nolibs-ocean-only-compile needs an argument" ; exit 911 ; fi + section-start nolibs-ocean-only-compile-$1 "Compiling ocean-only $1 executable" + if [ ! $DRYRUN ] ; then + cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + mkdir -p build-ocean-only-nolibs-$1 + cd build-ocean-only-nolibs-$1 + make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. -s + ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 + sed -i '/FMS1\/.*\/test_/d' path_names + ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names + (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + fi + section-end nolibs-ocean-only-compile-$1 +} + +# Build an ocean-ice executable without intermediate libraries +# Location: run in MOM6 directory +nolibs-ocean-ice-compile () { + if [ -z $1 ]; then echo "nolibs-ocean-ice-compile needs an argument" ; exit 911 ; fi + section-start nolibs-ocean-ice-compile-$1 "Compiling ocean-ice $1 executable" + if [ ! $DRYRUN ] ; then + cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + mkdir -p build-ocean-only-nolibs-$1 + cd build-ocean-only-nolibs-$1 + make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. -s + ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} + sed -i '/FMS1\/.*\/test_/d' path_names + ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names + (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + fi + section-end nolibs-ocean-ice-compile-$1 +} + +# Internal function to clean up stats files +# Args: list of top level directories to scan +clean-stats () { + find $@ -name "*.stats.*[a-z][a-z][a-z]" -delete +} + +# Internal function to clean up param files +# Args: list of top level directories to scan +clean-params () { + find $@ -name "*_parameter_doc.*" -delete + find $@ -name "*available_diags*" -delete +} + +# Internal function to check for core files +# Args: list of top level directories to scan +check-for-core-files () { + EXIT_CODE=0 + find $@ -name core -type f | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Internal function to clean up core files (needed for re-running) +# Args: list of top level directories to scan +clean-core-files () { + find $@ -name core -type f -delete +} + +# Internal function to run a sub-suite and copy results to storage +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +# $2 is sub-suite (_all, _ocean_only, _static_ocean_only, ...) +# $3 is MEMORY macro (dynamic_symmetric, dynamic_nonsymmetric, static) +# $4 is MODE macro (repro, debug) +# $5 is LAYOUT macro (def, alt) +mrs-run-sub-suite () { + if [ "$#" -ne 5 ]; then echo "mrs-run-sub-suite needs 5 arguments" ; exit 911 ; fi + section-start mrs-run-sub-suite-$1-$2-$3-$4-$5 "Running target $1-$2-$3-$4-$5" + EXP_GROUPS=`grep / manifest.mk | sed 's:/.*::' | uniq` + clean-stats $EXP_GROUPS + clean-params $EXP_GROUPS + clean-core-files $EXP_GROUPS + if [[ "$3" == *"_nonsym"* ]]; then + time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.$1 MEMORY=${3/_nonsym/_sym} MODE=$4 LAYOUT=$5 -s -j + fi + time make -f tools/MRS/Makefile.run $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j + tar cf - `find $EXP_GROUPS -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/$1-$2-$3-$4-$5-stats -xf - + tar cf - `find $EXP_GROUPS -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/$1-$2-$3-$4-$5-params -xf - + check-for-core-files $EXP_GROUPS + section-end mrs-run-sub-suite-$1-$2-$3-$4-$5 +} + +# Internal function to run restarts on a sub-suite and copy results to storage +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +# $2 is sub-suite (_all, _ocean_only, _static_ocean_only, ...) +# $3 is MEMORY macro (dynamic_symmetric, dynamic_nonsymmetric, static) +# $4 is MODE macro (repro, debug) +# $5 is LAYOUT macro (def, alt) +mrs-run-restarts-sub-suite () { + if [ "$#" -ne 5 ]; then echo "mrs-run-restarts-sub-suite needs 5 arguments" ; exit 911 ; fi + section-start mrs-run-restarts-sub-suite-$1-$2-$3-$4-$5 "Running target $1-$2-$3-$4-$5" + clean-stats $2 + clean-core-files $2 + time make -f tools/MRS/Makefile.restart $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j RESTART_STAGE=01 + check-for-core-files $2 + time make -f tools/MRS/Makefile.restart $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j RESTART_STAGE=02 + check-for-core-files $2 + time make -f tools/MRS/Makefile.restart $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j RESTART_STAGE=12 + check-for-core-files $2 + section-end mrs-run-restarts-sub-suite-$1-$2-$3-$4-$5 +} + +# Run a suite of experiments +# $1 - compiler brand +# $2 - any combination of "SNLDTR" +# S = symmetric +# N = non-symmetric +# L = layout +# D = debug +# R = restarts +run-suite () { + if [ "$#" -ne 2 ]; then echo "run-suite needs 2 arguments" ; exit 911 ; fi + section-start run-suite-$1-$2 "Running suite for $1-$2" + WORK_DIR=tmp-$CONFIGS_DIR-$1 + rm -f $JOB_DIR/CI-BATCH-SUCCESS-$1-$2 + set -e + set -v + + pushd $JOB_DIR/$STATS_REPO_DIR/$WORK_DIR > /dev/null + if [[ "$2" =~ "S" ]]; then # Symmetric + mrs-run-sub-suite $1 all dynamic_symmetric repro def + fi + if [[ "$2" =~ "N" ]]; then # Non-symmetric + mrs-run-sub-suite $1 all dynamic_nonsymmetric repro def + fi + if [[ "$2" =~ "L" ]]; then # Layout + mrs-run-sub-suite $1 all dynamic_symmetric repro alt + fi + if [[ "$2" =~ "D" ]]; then # Debug + mrs-run-sub-suite $1 ocean_only dynamic_symmetric debug def + fi + if [[ "$2" =~ "T" ]]; then # sTatic + mrs-run-sub-suite $1 static_ocean_only static repro def + fi + popd > /dev/null + if [[ "$2" =~ "R" ]]; then # Restarts + pushd $JOB_DIR/$STATS_REPO_DIR/$WORK_DIR-rst > /dev/null + mrs-run-restarts-sub-suite $1 ocean_only dynamic_symmetric repro def + mrs-run-restarts-sub-suite $1 ice_ocean_SIS2 dynamic_symmetric repro def + popd > /dev/null + fi + + # Indicate all went well + touch $JOB_DIR/CI-BATCH-SUCCESS-$1-$2 + + section-end run-suite-$1-$2 +} + +# Test the value of stats files. All files in results/ are checked for in regressions/. It is assumed +# missing files are intended and failed runs were caught earlier in the CI process. +# Args: +# $1 is path of results to test (relative to $STATS_REPO_DIR) +# $2 is path of correct results to test against (relative to $STATS_REPO_DIR) +compare-stats () { + if [ "$#" -ne 2 ]; then echo "compare-stats needs 2 arguments" ; exit 911 ; fi + section-start-open compare-stats-$1-$2-$3-$4-$5 "Checking stats for '$1' against '$2'" + # This checks that any file in the results directory is exactly the same as in regressions/ + ( cd $JOB_DIR/$STATS_REPO_DIR/$1 ; md5sum `find * -type f` ) | ( cd $JOB_DIR/$STATS_REPO_DIR/$2 ; md5sum -c ) 2>&1 | sed "s/ OK/$GRN&$OFF/;s/ FAILED/$RED&$OFF/;s/WARNING/$RED&$OFF/" + FAIL=${PIPESTATUS[1]} + if [ ! $FAIL == 0 ]; then + exit 911 + fi + section-end compare-stats-$1-$2-$3-$4-$5 +} + +# Test the value of stats files for a class of run +# $1 - compiler brand +# $2 - any combination of "SNLDTR" +# S = symmetric +# N = non-symmetric +# L = layout +# D = debug +# T = static +# R = restarts +# +# Many tests are tested against the "dynamic_symmetric repro" suite which must also have been run. +# The "dynamic_symmetric repro" tests alone are checked against the regressions. This is so that +# the pipelines might separate errors that are internally inconsistent. +check-stats () { + if [ "$#" -ne 2 ]; then echo "check-stats needs 2 arguments" ; exit 911 ; fi + + if [[ "$2" =~ "S" ]]; then # Symmetric + compare-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats regressions + fi + if [[ "$2" =~ "N" ]]; then # Non-symmetric + compare-stats $CONFIGS_DIR/results/$1-all-dynamic_nonsymmetric-repro-def-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "L" ]]; then # Layout + compare-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-alt-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "D" ]]; then # Debug + compare-stats $CONFIGS_DIR/results/$1-ocean_only-dynamic_symmetric-debug-def-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "T" ]]; then # sTatic + compare-stats $CONFIGS_DIR/results/$1-static_ocean_only-static-repro-def-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "R" ]]; then # Restarts + pushd $JOB_DIR/$STATS_REPO_DIR/tmp-$CONFIGS_DIR-$1-rst > /dev/null + make -f tools/MRS/Makefile.restart restart_$1_ocean_only restart_$1_ice_ocean_SIS2 -s -k + popd > /dev/null + fi + +} + +# Helper function to compare two files +# Args: +# $1 is source directory +# $2 is target directory +# $3- are file names that should exist relative to both $1 and $2 +# +# Operations for `compare-files src/ tgt/ file1 file2 file3`: +# 1. create the md5sum of file1, file2, and file3, in src/ and then run `md5sum-c` in tgt/ +# 2. if differences are detected, +# a. report the "OK" results first, then the "FAILED". +# b. report the "FAILED". +# c. for each failed file, show the `diff src/$f tgt/$f` +# 3. if no differences are detected, show `md5sum -c` output so the log lists all files that were checked +compare-files () { + SRC=$1 + TGT=$2 + shift; shift + FILES=$@ + ( cd $SRC ; md5sum $FILES ) | ( cd $TGT ; md5sum -c ) | sed -r "s/([A-Za-z0-9_\.\/\-]*): ([A-Z]*)/\2 \1/;s/OK /${GRN}PASS$OFF /;s/FAILED /${RED}FAILED$OFF /" + FAIL=${PIPESTATUS[1]} + if [ ! $FAIL == 0 ]; then + echo Differences follow: + # All is not well so re-order md5sum to summarize status + DFILES=$( ( cd $SRC ; md5sum $FILES ) | ( cd $TGT ; md5sum -c 2> /dev/null ) | grep ": FAILED" | sed 's/:.*//') + for f in $DFILES; do + echo diff $SRC/$f $TGT/$f | sed "s:$JOB_DIR/$STATS_REPO_DIR/::g;s:$CONFIGS_DIR/results/::" + diff $SRC/$f $TGT/$f || true + done + echo Files $DFILES had differences + exit 911 + fi +} + +# Test the value of param files. All files generated in results/ are looked for $CONFIGS_DIR +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +check-params () { + if [ "$#" -ne 1 ]; then echo "check-params needs 1 argument" ; exit 911 ; fi + section-start-open check-params-$1 "Checking params for $1" + SRC=$JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-params + FILES=$( cd $SRC ; find * -name "*parameter_doc*" -type f ) + compare-files $SRC $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR $FILES + section-end check-params-$1 +} + +# Test the value of available_diag files. Only those recorded in $CONFIGS_DIR are checked. +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +check-diags () { + if [ "$#" -ne 1 ]; then echo "check-diags needs 1 argument" ; exit 911 ; fi + section-start-open check-diags-$1 "Checking diagnostics for $1" + # This checks that any file in the results directory is exactly the same as in regressions/ + SRC=$JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-params + TGT=$JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + EXP_GROUPS=`grep / $TGT/manifest.mk | sed 's:/.*::' | uniq` + #FILES=$( cd $TGT ; find $EXP_GROUPS -name "*available_diags*" -type f ) + # The following option finds the intersection between all available_diags in both $TGT and $SRC because + # $SRC contains more than are recorded in $TGT but $TGT might have some that we no longer monitor + FILES=$( comm -12 <(cd $SRC; find $EXP_GROUPS -name '*available_diags*' -type f | sort) <(cd $TGT; find $EXP_GROUPS -name '*available_diags*' -type f | sort) ) + compare-files $SRC $TGT $FILES + section-end check-diags-$1 +} + +# Process command line +START_DIR=`pwd` +while [[ $# -gt 0 ]]; do # Loop through arguments + cd $START_DIR + arg=$1 + shift + case "$arg" in + -n | --norun) + DRYRUN=1; echo Dry-run enabled; continue ;; + +n | ++norun) + DRYRUN=; echo Dry-run disabled; continue ;; + -x) + set -x; continue ;; + +x) + set +x; continue ;; + clean-job-dir) + clean-job-dir; continue ;; + create-job-dir) + create-job-dir https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git dev/gfdl; continue ;; + copy-test-space) + copy-test-space $1; shift; continue ;; + mrs-compile) + mrs-compile $1; shift; continue ;; + nolibs-ocean-only-compile) + nolibs-ocean-only-compile $1; shift; continue ;; + nolibs-ocean-ice-compile) + nolibs-ocean-ice-compile $1; shift; continue ;; + run-suite) + run-suite $1 $2; shift; shift; continue ;; + check-stats) + check-stats $1 $2; shift; shift; continue ;; + check-params) + check-params $1; shift; continue ;; + check-diags) + check-diags $1; shift; continue ;; + *) + echo \"$arg\" is not a recognized argument! ; exit 9 ;; + esac +done From f95a5ffe81f5225c0b63c5477df323cab44d6b08 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 17 Oct 2022 16:20:01 -0400 Subject: [PATCH 013/213] Bug fix for categorize_axes causing crash - The subroutine categorize_axes cannot find the axes in ice restart files and gives warnings WARNING from PE 0: categorize_axes: Failed to identify x- and y- axes in the axis list (xaxis_1, yaxis_1, Time) of a variable being read from INPUT/ice_model.res.nc - This leads to an incorrect initializations and a subsequent sat.vap.press.overflow crash when using infra/FMS2 - Same experiment runs fine with infra/FMS1 - After the fix the infra/FMS1 and infra/FMS2 answers are bitwise identical --- config_src/infra/FMS2/MOM_io_infra.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index dc8a9af3d5..955c39fd02 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -1686,6 +1686,12 @@ subroutine categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. + elseif (variable_att_exists(fileobj, trim(dim_names(i)), "axis")) then + call get_variable_attribute(fileobj, trim(dim_names(i)), "axis", cartesian) + cartesian = adjustl(cartesian) + if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. + if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. + if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. endif endif endif From 7d9bf03a2f3e78375bd862358c709d384c5eab51 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 17 Oct 2022 20:09:54 -0400 Subject: [PATCH 014/213] Bug fix for categorize_axes causing crash - The subroutine categorize_axes cannot find the axes in ice restart files and gives warnings WARNING from PE 0: categorize_axes: Failed to identify x- and y- axes in the axis list (xaxis_1, yaxis_1, Time) of a variable being read from I NPUT/ice_model.res.nc - This leads to an incorrect initializations and a subsequent sat.vap.press.overflow crash when using infra/FMS2 - Same experiment runs fine with infra/FMS1 - After the fix the infra/FMS1 and infra/FMS2 answers are bitwise identical --- config_src/infra/FMS2/MOM_io_infra.F90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 955c39fd02..555d03d05f 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -1682,17 +1682,13 @@ subroutine categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t if (variable_exists(fileobj, trim(dim_names(i)))) then if (variable_att_exists(fileobj, trim(dim_names(i)), "cartesian_axis")) then call get_variable_attribute(fileobj, trim(dim_names(i)), "cartesian_axis", cartesian) - cartesian = adjustl(cartesian) - if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. - if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. - if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. elseif (variable_att_exists(fileobj, trim(dim_names(i)), "axis")) then call get_variable_attribute(fileobj, trim(dim_names(i)), "axis", cartesian) - cartesian = adjustl(cartesian) - if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. - if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. - if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. endif + cartesian = adjustl(cartesian) + if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. + if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. + if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. endif endif if (is_x(i)) x_found = .true. From e26d8dada95b96f76d0770733b2e11fd97217eff Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Oct 2022 15:53:59 -0400 Subject: [PATCH 015/213] Avoid an uninitialized string in categorize_axes Added a line initializing the string Cartesian to a blank string in categorize_axes, so that it not be uninitialized when it is used a few lines later. --- config_src/infra/FMS2/MOM_io_infra.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 555d03d05f..c49c124ae0 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -1680,6 +1680,7 @@ subroutine categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t ! First look for indicative variable attributes if (.not.is_t(i)) then if (variable_exists(fileobj, trim(dim_names(i)))) then + cartesian = "" if (variable_att_exists(fileobj, trim(dim_names(i)), "cartesian_axis")) then call get_variable_attribute(fileobj, trim(dim_names(i)), "cartesian_axis", cartesian) elseif (variable_att_exists(fileobj, trim(dim_names(i)), "axis")) then From 82cbb09b7c741ea78715613849432fefad55e2ea Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Oct 2022 06:04:03 -0400 Subject: [PATCH 016/213] (*)Simplify interpolate_column weight calculations Set the interpolation weights inside of interpolate_column to explicitly be the complement of one another, thereby saving an extra division at each point and reducing the number of variables that need to be stored, in preparation for the creation of a separate subroutine to find interface positions. This commit is mathematically equivalent to what was there before, and the extensive unit testing of interpolate_column is still passing, but it changes the value of some interpolated interface diagnostics at the level of roundoff (but not the MOM6 solutions themselves, as they do not depend on interpolate_column yet). --- src/ALE/MOM_remapping.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index fa79c50c3c..bfd74b435c 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -877,12 +877,13 @@ subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest) enddo if (dh>0.) then - weight_a = max(0., ( dh - x_dest ) / dh) ! Weight of u1 - weight_b = min(1., x_dest / dh) ! Weight of u2 - u_dest(k_dest) = weight_a * u1 + weight_b * u2 ! Linear interpolation between u1 and u2 - else - u_dest(k_dest) = 0.5 * ( u1 + u2 ) ! For a vanished layer we need to do something reasonable... + weight_b = max(0., min(1., x_dest / dh)) ! Weight of u2 + else ! For a vanished source layer we need to do something reasonable... + weight_b = 0.5 endif + weight_a = 1.0 - weight_b ! Weight of u1 + ! Linear interpolation between u1 and u2 + u_dest(k_dest) = weight_a * u1 + weight_b * u2 ! Mask vanished layers at the surface which would be under an ice-shelf. ! TODO: Need to figure out what to do for an isopycnal coordinate diagnostic that could From d46de87a5329d63ee2257fd7d66ad4d7cb4315b0 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 3 Nov 2022 13:36:54 -0400 Subject: [PATCH 017/213] Autoconf: Fortran-netCDF C compatibility test This patch introduces a new autoconf macro, AX_FC_CHECK_C_LIB, which confirms if the Fortran compiler can be linked to the netCDF C library. As with other netCDF tests, the nc-config tool is used if necessary (and available). This resolves some recent issues on platforms where netCDF and netCDF-Fortran are installed in separate locations, with different library directories (-L). It also resolves some false assumptions in configure.ac which presumed equivalent access by the configured C and Fortran compilers. Previously, we would test if the C compiler could be linked to netCDF, and then assume that the Fortran compiler shared the same relationship. We now use the Fortran compiler for both C and Fortran tests. This patch fixes many issues observed on MacOS systems, including some persistent problems on the GitHub Actions MacOS tests. For example, we can now use the default GCC 12 compilers, rather than forcing a rollback to GCC 11. --- .github/actions/macos-setup/action.yml | 2 +- .github/workflows/macos-regression.yml | 4 +-- .github/workflows/macos-stencil.yml | 4 +-- ac/configure.ac | 43 ++++++++++++------------ ac/m4/ax_fc_check_c_lib.m4 | 45 ++++++++++++++++++++++++++ 5 files changed, 70 insertions(+), 28 deletions(-) create mode 100644 ac/m4/ax_fc_check_c_lib.m4 diff --git a/.github/actions/macos-setup/action.yml b/.github/actions/macos-setup/action.yml index 197a2d83c8..fecbe787b5 100644 --- a/.github/actions/macos-setup/action.yml +++ b/.github/actions/macos-setup/action.yml @@ -10,7 +10,7 @@ runs: shell: bash run: | echo "::group::Install packages" - brew update + brew reinstall gcc brew install automake brew install netcdf brew install netcdf-fortran diff --git a/.github/workflows/macos-regression.yml b/.github/workflows/macos-regression.yml index d975854e0c..dc86a52212 100644 --- a/.github/workflows/macos-regression.yml +++ b/.github/workflows/macos-regression.yml @@ -8,8 +8,8 @@ jobs: runs-on: macOS-latest env: - CC: gcc-11 - FC: gfortran-11 + CC: gcc + FC: gfortran defaults: run: diff --git a/.github/workflows/macos-stencil.yml b/.github/workflows/macos-stencil.yml index 33436c221f..96240f31f8 100644 --- a/.github/workflows/macos-stencil.yml +++ b/.github/workflows/macos-stencil.yml @@ -8,8 +8,8 @@ jobs: runs-on: macOS-latest env: - CC: gcc-11 - FC: gfortran-11 + CC: gcc + FC: gfortran defaults: run: diff --git a/ac/configure.ac b/ac/configure.ac index 8d74d71fbd..58b05c7aaa 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -105,7 +105,7 @@ AX_FC_CHECK_MODULE([mpi], # netCDF configuration -# Search for the Fortran netCDF module, fallback to nf-config. +# Search for the Fortran netCDF module. AX_FC_CHECK_MODULE([netcdf], [], [ AS_UNSET([ax_fc_cv_mod_netcdf]) AC_PATH_PROG([NF_CONFIG], [nf-config]) @@ -118,39 +118,37 @@ AX_FC_CHECK_MODULE([netcdf], [], [ ]) ]) -# FMS may invoke netCDF C calls, so we link to libnetcdf. -AC_LANG_PUSH([C]) -AC_CHECK_LIB([netcdf], [nc_create], [], [ - AS_UNSET([ac_cv_lib_netcdf_nc_create]) +# Confirm that the Fortran compiler can link the netCDF C library +AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AS_UNSET([ax_fc_cv_c_lib_netcdf_nc_create]) AC_PATH_PROG([NC_CONFIG], [nc-config]) AS_IF([test -n "$NC_CONFIG"], [ - AC_SUBST([LDFLAGS], - ["$LDFLAGS -L$($NC_CONFIG --libdir)"] - ) - ], [AC_MSG_ERROR([Could not find nc-config.])] - ) - AC_CHECK_LIB([netcdf], [nc_create], [], [ - AC_MSG_ERROR([Could not find libnetcdf.]) + AC_SUBST([LDFLAGS], ["$LDFLAGS -L$($NC_CONFIG --libdir)"]) + ], [ + AC_MSG_ERROR([Could not find nc-config.]) + ]) + AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AC_MSG_ERROR([Could not find netCDF C library.]) ]) ]) -AC_LANG_POP([C]) -# NOTE: We test for nf_create, rather than nf90_create, because AX_FC_CHECK_LIB -# is currently not yet able to properly probe inside modules. -# NOTE: nf-config does not have --libdir, so we use the first term of flibs. - -# Link to Fortran netCDF library, netcdff +# Confirm that the Fortran compiler can link to the netCDF Fortran library. +# NOTE: +# - We test nf_create, rather than nf90_create, since AX_FC_CHECK_LIB can +# not currently probe the Fortran 90 interfaces. +# - nf-config does not have --libdir, so we parse the --flibs output. AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ AS_UNSET([ax_fc_cv_lib_netcdff_nf_create]) AC_PATH_PROG([NF_CONFIG], [nf-config]) AS_IF([test -n "$NF_CONFIG"], [ AC_SUBST([LDFLAGS], - ["$LDFLAGS $($NF_CONFIG --flibs | cut -f1 -d" ")"] + ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] ) - ], [AC_MSG_ERROR([Could not find nf_create.])] - ) + ], [ + AC_MSG_ERROR([Could not find nf-config.]) + ]) AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ - AC_MSG_ERROR([Could not find libnetcdff.]) + AC_MSG_ERROR([Could not find netCDF Fortran library.]) ]) ]) @@ -268,4 +266,3 @@ AC_LANG_POP([C]) AC_SUBST([CPPFLAGS]) AC_CONFIG_FILES([Makefile:${srcdir}/ac/Makefile.in]) AC_OUTPUT - diff --git a/ac/m4/ax_fc_check_c_lib.m4 b/ac/m4/ax_fc_check_c_lib.m4 new file mode 100644 index 0000000000..ea41786fb7 --- /dev/null +++ b/ac/m4/ax_fc_check_c_lib.m4 @@ -0,0 +1,45 @@ +dnl AX_FC_CHECK_C_LIB(LIBRARY, FUNCTION, +dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND], +dnl [OTHER-LDFLAGS], [OTHER-LIBS]) +dnl +dnl This macro checks if a C binding is available to the compiler. +dnl +dnl Equivalently, it checks if the Fortran compiler can see a C function. +dnl +dnl Results are cached in `ax_fc_cv_c_lib_LIBRARY_FUNCTION`. +dnl +AC_DEFUN([AX_FC_CHECK_C_LIB], [ + AS_VAR_PUSHDEF([ax_fc_C_Lib], [ax_fc_cv_c_lib_$1_$2]) + m4_ifval([$5], + [ax_fc_c_lib_msg_LDFLAGS=" with $5"], + [ax_fc_c_lib_msg_LDFLAGS=""] + ) + AC_CACHE_CHECK( + [for $2 in -l$1$ax_fc_c_lib_msg_LDFLAGS], [ax_fc_cv_c_lib_$1_$2], [ + ax_fc_check_c_lib_save_LDFLAGS=$LDFLAGS + LDFLAGS="$6 $LDFLAGS" + ax_fc_check_c_lib_save_LIBS=$LIBS + LIBS="-l$1 $7 $LIBS" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([],[dnl +dnl begin code block + interface + subroutine test() bind(c, name="$2") + end subroutine test + end interface + call test]) +dnl end code block + ], + [AS_VAR_SET([ax_fc_C_Lib], [yes])], + [AS_VAR_SET([ax_fc_C_Lib], [no])] + ) + LDFLAGS=$ax_fc_check_c_lib_save_LDFLAGS + LIBS=$ax_fc_check_c_lib_save_LIBS + ] + ) + AS_VAR_IF([ax_fc_C_Lib], [yes], + [m4_default([$3], [LIBS="-l$1 $LIBS"])], + [$4] + ) + AS_VAR_POPDEF([ax_fc_C_Lib]) +]) From 522e7aa67cba9cc21884d7b014b98d2fe2ca3c11 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 9 Nov 2022 12:52:16 -0500 Subject: [PATCH 018/213] Autoconf: Fortran testing of C bindings This patch fixes some issues with testing of C bindings in Fortran. Specifically, some tests are using a C compiler which may be unconfigured, causing unexpected errors. The autoconf script now uses the Fortran compiler to test these bindings, rather than using the C compiler to test for their existence. A new macro (AX_FC_CHECK_BIND_C) was added to run these tests. This achieves the actual goal (test of Fortran binding) on top of the original goal (availability of C function), while ensuring that the actual compiler of interest (FC) is used in the test. Two C-based tests are still present in the script for testing the size of jmp_buf and sigjmp_buf. The C compiler is now configured with the AX_MPI macro, and is only used to determine the size of these structs. --- ac/configure.ac | 25 ++++++++++++++-------- ac/m4/ax_fc_check_bind_c.m4 | 42 +++++++++++++++++++++++++++++++++++++ ac/m4/ax_fc_check_c_lib.m4 | 6 +++--- 3 files changed, 61 insertions(+), 12 deletions(-) create mode 100644 ac/m4/ax_fc_check_bind_c.m4 diff --git a/ac/configure.ac b/ac/configure.ac index 58b05c7aaa..049325a891 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -88,8 +88,9 @@ AC_FC_SRCEXT(f90) # - This can cause standard AC_PROG_FC tests to fail if FCFLAGS is configured # with flags from another compiler. # - I do not yet know how to resolve this possible issue. -AX_MPI([], - [AC_MSG_ERROR([Could not find MPI launcher.])]) +AX_MPI([], [ + AC_MSG_ERROR([Could not find MPI launcher.]) +]) # Explicitly replace FC and LD with MPI wrappers @@ -233,13 +234,13 @@ AC_CONFIG_COMMANDS(Makefile.dep, [make depend]) # POSIX verification tests -AC_LANG_PUSH([C]) # These symbols may be defined as macros, making them inaccessible by Fortran. -# The following exist in BSD and Linux, so we just test for them. -AC_CHECK_FUNC([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])]) -AC_CHECK_FUNC([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])]) -AC_CHECK_FUNC([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) +# These three exist in modern BSD and Linux libc, so we just confirm them. +# But one day, we many need to handle them more carefully. +AX_FC_CHECK_BIND_C([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])]) +AX_FC_CHECK_BIND_C([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])]) +AX_FC_CHECK_BIND_C([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) # Determine the sigsetjmp symbol. If missing, then point to sigsetjmp_missing. # @@ -248,14 +249,20 @@ AC_CHECK_FUNC([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) # __sigsetjmp glibc (Linux) SIGSETJMP="sigsetjmp_missing" for sigsetjmp_fn in sigsetjmp __sigsetjmp; do - AC_CHECK_FUNC([${sigsetjmp_fn}], [ + AX_FC_CHECK_BIND_C([${sigsetjmp_fn}], [ SIGSETJMP=${sigsetjmp_fn} break ]) done AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["${SIGSETJMP}"]) -# Determine the size of jmp_buf and sigjmp_buf +# Verify the size of nonlocal jump buffer structs +# NOTE: This requires C compiler, but can it be done with a Fortran compiler? +AC_LANG_PUSH([C]) + +AX_MPI([], [AC_MSG_ERROR([Could not find MPI launcher.])]) +AC_SUBST([CC], [$MPICC]) + AC_CHECK_SIZEOF([jmp_buf], [], [#include ]) AC_CHECK_SIZEOF([sigjmp_buf], [], [#include ]) diff --git a/ac/m4/ax_fc_check_bind_c.m4 b/ac/m4/ax_fc_check_bind_c.m4 new file mode 100644 index 0000000000..9b9f821d4c --- /dev/null +++ b/ac/m4/ax_fc_check_bind_c.m4 @@ -0,0 +1,42 @@ +dnl AX_FC_CHECK_C_LIB(FUNCTION, +dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND], +dnl [OTHER-LDFLAGS], [OTHER-LIBS]) +dnl +dnl This macro checks if a C binding is available to the compiler. +dnl +dnl Equivalently, it checks if the Fortran compiler can see a C function. +dnl +dnl Results are cached in `ax_fc_cv_bind_c_FUNCTION`. +dnl +AC_DEFUN([AX_FC_CHECK_BIND_C], [ + AS_VAR_PUSHDEF([ax_fc_Bind_C], [ax_fc_cv_bind_c_$1]) + m4_ifval([$4], + [ax_fc_bind_c_msg_LDFLAGS=" with $4"], + [ax_fc_bind_c_msg_LDFLAGS=""] + ) + AC_CACHE_CHECK( + [if $FC can bind $1$ax_fc_bind_c_msg_LDFLAGS], [ax_fc_cv_bind_c_$1], [ + ax_fc_check_bind_c_save_LDFLAGS=$LDFLAGS + LDFLAGS="$4 $LDFLAGS" + ax_fc_check_bind_c_save_LIBS=$LIBS + LIBS="$5 $LIBS" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([],[dnl +dnl begin code block + interface + subroutine test() bind(c, name="$1") + end subroutine test + end interface + call test]) +dnl end code block + ], + [AS_VAR_SET([ax_fc_Bind_C], [yes])], + [AS_VAR_SET([ax_fc_Bind_C], [no])] + ) + LDFLAGS=$ax_fc_check_bind_c_save_LDFLAGS + LIBS=$ax_fc_check_bind_c_save_LIBS + ] + ) + AS_VAR_IF([ax_fc_Bind_C], [yes], [$2], [$3]) + AS_VAR_POPDEF([ax_fc_Bind_C]) +]) diff --git a/ac/m4/ax_fc_check_c_lib.m4 b/ac/m4/ax_fc_check_c_lib.m4 index ea41786fb7..af5765282a 100644 --- a/ac/m4/ax_fc_check_c_lib.m4 +++ b/ac/m4/ax_fc_check_c_lib.m4 @@ -2,12 +2,12 @@ dnl AX_FC_CHECK_C_LIB(LIBRARY, FUNCTION, dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND], dnl [OTHER-LDFLAGS], [OTHER-LIBS]) dnl -dnl This macro checks if a C binding is available to the compiler. -dnl -dnl Equivalently, it checks if the Fortran compiler can see a C function. +dnl This macro checks if a C library can be referenced by a Fortran compiler. dnl dnl Results are cached in `ax_fc_cv_c_lib_LIBRARY_FUNCTION`. dnl +dnl NOTE: Might be possible to rewrite this to use `AX_FC_CHECK_BIND_C`. +dnl AC_DEFUN([AX_FC_CHECK_C_LIB], [ AS_VAR_PUSHDEF([ax_fc_C_Lib], [ax_fc_cv_c_lib_$1_$2]) m4_ifval([$5], From 9d5a320db71309220061cf2a5dfbfa0c9e7e81c1 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 10 Nov 2022 04:33:34 -0500 Subject: [PATCH 019/213] Obc setup plus segment update period (#198) * Setup OBC segments for COBALT/OBGC tracers - These are updates required to setup OBC segments for OBGC tracers. - Since COBALT package has more than 50 tracers using the MOM6 table mechanism for setting up OBC segments is not feasible. Rather, this update delegates such setup to mechanims used in ocean_BGS tracers leaving MOM6 mechanism for native tracers intact. - Fixed issues caught by MOM6 githubCI * Add capability to change obc segment update period - COBALT tracers do not need as frequent segment bc updates and can use a larger update period to speed up the model. This commit introduces a new parameter DT_OBC_SEG_UPDATE_OBGC that can be adjusted for obc segment update period. - This commit applies the change only to BGC tracers but can easily be changed to apply for all. * Insert missing US%T_to_sec - The unit conversion factor was missing causing a crash in a newer test. * Updates from Andrew Ross - Avoid low initial values in the tracer reservoirs * Per Andrew Ross review * corrected indentation per review * Avoid using module vars per review request - Reviewer asked to avoid using module variables with "save" attributes. - This commit hides the module variables inside the existing OBC type. * Coding style corrections per review * Modification per review: do_not_log if .not.associated(CS%OBC) Co-authored-by: Robert Hallberg --- .../GFDL_ocean_BGC/generic_tracer_utils.F90 | 14 + src/core/MOM.F90 | 34 ++- src/core/MOM_open_boundary.F90 | 246 +++++++++++++++++- src/tracer/MOM_generic_tracer.F90 | 62 ++++- src/tracer/MOM_tracer_flow_control.F90 | 24 +- 5 files changed, 358 insertions(+), 22 deletions(-) diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 index cbc310eb7d..e0d3b1d6a9 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -25,6 +25,8 @@ module g_tracer_utils character(len=fm_string_len) :: src_var_name !< Tracer source variable name character(len=fm_string_len) :: src_var_unit !< Tracer source variable units character(len=fm_string_len) :: src_var_gridspec !< Tracer source grid file name + character(len=fm_string_len) :: obc_src_file_name !< Boundary condition tracer source filename + character(len=fm_string_len) :: obc_src_field_name !< Boundary condition tracer source fieldname integer :: src_var_record !< Unknown logical :: requires_src_info = .false. !< Unknown real :: src_var_unit_conversion = 1.0 !< This factor depends on the tracer. Ask Jasmin @@ -61,6 +63,7 @@ module g_tracer_utils public :: g_tracer_get_next public :: g_tracer_is_prog public :: g_diag_type + public :: g_tracer_get_obc_segment_props !> Set the values of various (array) members of the tracer node g_tracer_type !! @@ -284,6 +287,17 @@ subroutine g_tracer_get_next(g_tracer,g_tracer_next) type(g_tracer_type), pointer :: g_tracer_next !< Pointer to the next tracer node in the list end subroutine g_tracer_get_next + !> get obc segment properties for each tracer + subroutine g_tracer_get_obc_segment_props(g_tracer_list, name, obc_has, src_file, src_var_name,lfac_in,lfac_out) + type(g_tracer_type), pointer :: g_tracer_list !< pointer to the head of the generic tracer list + character(len=*), intent(in) :: name !< tracer name + logical, intent(out):: obc_has !< .true. if This tracer has OBC + real, optional,intent(out):: lfac_in !< OBC reservoir inverse lengthscale factor + real, optional,intent(out):: lfac_out !< OBC reservoir inverse lengthscale factor + character(len=*),optional,intent(out):: src_file !< OBC source file + character(len=*),optional,intent(out):: src_var_name !< OBC source variable in file + end subroutine g_tracer_get_obc_segment_props + !>Vertical Diffusion of a tracer node !! !! This subroutine solves a tridiagonal equation to find and set values of vertically diffused field diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c61f130ef7..fef71ab4d5 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -133,7 +133,7 @@ module MOM use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state -use MOM_tracer_flow_control, only : tracer_flow_control_end +use MOM_tracer_flow_control, only : tracer_flow_control_end, call_tracer_register_obc_segments use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling @@ -294,7 +294,11 @@ module MOM !! barotropic time step [s]. If this is negative dtbt is never !! calculated, and if it is 0, dtbt is calculated every step. type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. - type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. + type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. + real :: dt_obc_seg_period !< The time interval between OBC segment updates for OBGC tracers + type(time_type) :: dt_obc_seg_interval !< A time_time representation of dt_obc_seg_period. + type(time_type) :: dt_obc_seg_time !< The next time OBC segment update is applied to OBGC tracers. + real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied !! by ice shelf [nondim] real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2] @@ -1132,6 +1136,17 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call disable_averaging(CS%diag) endif + !OBC segment data update for some fields can be less frequent than others + if(associated(CS%OBC)) then + CS%OBC%update_OBC_seg_data = .false. + if (CS%dt_obc_seg_period == 0.0) CS%OBC%update_OBC_seg_data = .true. + if (CS%dt_obc_seg_period > 0.0) then + if (Time_local >= CS%dt_obc_seg_time) then + CS%OBC%update_OBC_seg_data = .true. + CS%dt_obc_seg_time = CS%dt_obc_seg_time + CS%dt_obc_seg_interval + endif + endif + endif if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, @@ -2152,6 +2167,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & units="s", default=default_val, do_not_read=(dtbt > 0.0)) endif + CS%dt_obc_seg_period = -1.0 + call get_param(param_file, "MOM", "DT_OBC_SEG_UPDATE_OBGC", CS%dt_obc_seg_period, & + "The time between OBC segment data updates for OBGC tracers. "//& + "This must be an integer multiple of DT and DT_THERM. "//& + "The default is set to DT.", & + units="s", default=US%T_to_s*CS%dt, do_not_log=.not.associated(CS%OBC)) + ! This is here in case these values are used inappropriately. use_frazil = .false. ; bound_salinity = .false. CS%tv%P_Ref = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 @@ -2627,6 +2649,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! could occur with the call to update_OBC_data or after the main initialization. if (use_temperature) & call register_temp_salt_segments(GV, US, CS%OBC, CS%tracer_Reg, param_file) + !This is the equivalent call to register_temp_salt_segments for external tracers with OBC + call call_tracer_register_obc_segments(GV, param_file, CS%tracer_flow_CSp, CS%tracer_Reg, CS%OBC) ! This needs the number of tracers and to have called any code that sets whether ! reservoirs are used. @@ -2962,6 +2986,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%ntrunc, cont_stencil=CS%cont_stencil) endif + !Set OBC segment data update period + if (associated(CS%OBC) .and. CS%dt_obc_seg_period > 0.0) then + CS%dt_obc_seg_interval = real_to_time(US%T_to_s*CS%dt_obc_seg_period) + CS%dt_obc_seg_time = Time + CS%dt_obc_seg_interval + endif + call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1cc8505d17..7d89d97c0f 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -57,7 +57,11 @@ module MOM_open_boundary public segment_tracer_registry_end public register_segment_tracer public register_temp_salt_segments +public register_obgc_segments public fill_temp_salt_segments +public fill_obgc_segments +public set_obgc_segments_props +public setup_OBC_tracer_reservoirs public open_boundary_register_restarts public update_segment_tracer_reservoirs public update_OBC_ramp @@ -78,7 +82,8 @@ module MOM_open_boundary type, public :: OBC_segment_data_type integer :: fid !< handle from FMS associated with segment data on disk integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk - character(len=8) :: name !< a name identifier for the segment data + character(len=32) :: name !< a name identifier for the segment data + character(len=8) :: genre !< an identifier for the segment data real :: scale !< A scaling factor for converting input data to !! the internal units of this field real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces @@ -91,6 +96,10 @@ module MOM_open_boundary !! The values for tracers should have the same units as the field !! they are being applied to? real :: value !< constant value if fid is equal to -1 + real :: resrv_lfac_in = 1. !< reservoir inverse length scale factor for IN direction per field + !< the general 1/Lscale_IN is multiplied by this factor for each tracer + real :: resrv_lfac_out= 1. !< reservoir inverse length scale factor for OUT direction per field + !< the general 1/Lscale_OUT is multiplied by this factor for each tracer end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. @@ -262,6 +271,8 @@ module MOM_open_boundary logical :: user_BCs_set_globally = .false. !< True if any OBC_USER_CONFIG is set !! for input from user directory. logical :: update_OBC = .false. !< Is OBC data time-dependent + logical :: update_OBC_seg_data = .false. !< Is it the time for OBC segment data update for fields that + !! require less frequent update logical :: needs_IO_for_data = .false. !< Is any i/o needed for OBCs logical :: zero_vorticity = .false. !< If True, sets relative vorticity to zero on open boundaries. logical :: freeslip_vorticity = .false. !< If True, sets normal gradient of tangential velocity to zero @@ -304,6 +315,9 @@ module MOM_open_boundary ! Which segment object describes the current point. integer, allocatable :: segnum_u(:,:) !< Segment number of u-points. integer, allocatable :: segnum_v(:,:) !< Segment number of v-points. + ! Keep the OBC segment properties for external BGC tracers + type(external_tracers_segments_props), pointer :: obgc_segments_props => NULL() !< obgc segment properties + integer :: num_obgc_tracers = 0 !< The total number of obgc tracers ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation @@ -370,6 +384,15 @@ module MOM_open_boundary !! When locked=.true.,no more boundaries can be registered. end type OBC_registry_type +!> Type to carry OBC information needed for setting segments for OBGC tracers +type, private :: external_tracers_segments_props + type(external_tracers_segments_props), pointer :: next => NULL() !< pointer to the next node + character(len=128) :: tracer_name !< tracer name + character(len=128) :: tracer_src_file !< tracer source file for BC + character(len=128) :: tracer_src_field !< name of the field in source file to extract BC + real :: lfac_in !< multiplicative factor for inbound tracer reservoir length scale + real :: lfac_out !< multiplicative factor for outbound tracer reservoir length scale +end type external_tracers_segments_props integer :: id_clock_pass !< A CPU time clock character(len=40) :: mdl = "MOM_open_boundary" !< This module's name. @@ -704,7 +727,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure type(param_file_type), intent(in) :: PF !< Parameter file handle - integer :: n, m, num_fields + integer :: n, m, num_fields, mm character(len=1024) :: segstr character(len=256) :: filename character(len=20) :: segnam, suffix @@ -721,6 +744,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) integer, dimension(:), allocatable :: saved_pelist integer :: current_pe integer, dimension(1) :: single_pelist + type(external_tracers_segments_props), pointer :: obgc_segments_props_list =>NULL() !will be able to dynamically switch between sub-sampling refined grid data or model grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -772,8 +796,9 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) cycle ! cycle to next segment endif - allocate(segment%field(num_fields)) - segment%num_fields = num_fields + !There are OBC%num_obgc_tracers obgc tracers are there that are not listed in param file + segment%num_fields = num_fields + OBC%num_obgc_tracers + allocate(segment%field(segment%num_fields)) segment%temp_segment_data_exists = .false. segment%salt_segment_data_exists = .false. @@ -786,9 +811,28 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB - do m=1,num_fields - call parse_segment_data_str(trim(segstr), m, trim(fields(m)), & - value, filename, fieldname) + obgc_segments_props_list => OBC%obgc_segments_props !pointer to the head node + do m=1,segment%num_fields + if (m .le. num_fields) then + !These are tracers with segments specified in MOM6 style override files + call parse_segment_data_str(trim(segstr), m, trim(fields(m)), value, filename, fieldname) + else + !These are obgc tracers with segments specified by external modules. + !Set a flag so that these can be distinguished from native tracers as they may need + !extra steps for preparation and handling. + segment%field(m)%genre = 'obgc' + !Query the obgc segment properties by traversing the linkedlist + call get_obgc_segments_props(obgc_segments_props_list,fields(m),filename,fieldname,& + segment%field(m)%resrv_lfac_in,segment%field(m)%resrv_lfac_out) + !Make sure the obgc tracer is not specified in the MOM6 param file too. + do mm=1,num_fields + if(trim(fields(m)) == trim(fields(mm))) then + if(is_root_pe()) & + call MOM_error(FATAL,"MOM_open_boundary:initialize_segment_data(): obgc tracer " //trim(fields(m))// & + " appears in OBC_SEGMENT_XXX_DATA string in MOM6 param file. This is not supported!") + endif + enddo + endif if (trim(filename) /= 'none') then OBC%update_OBC = .true. ! Data is assumed to be time-dependent if we are reading from file OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data @@ -1737,7 +1781,7 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables - integer :: n,m,num_fields + integer :: n,m,num_fields,na character(len=1024) :: segstr character(len=256) :: filename character(len=20) :: segnam, suffix @@ -1789,6 +1833,23 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) OBC%tracer_y_reservoirs_used(2) = .true. endif endif + !Add reservoirs for external/obgc tracers + !There is a diconnect in the above logic between tracer index and reservoir index. + !It arbitarily assigns reservoir indexes 1&2 to tracers T&S, + !So we need to start from reservoir index for non-native tracers from 3, hence na=2 below. + !num_fields is the number of vars in segstr (6 of them now, U,V,SSH,TEMP,SALT,dye) + !but OBC%tracer_x_reservoirs_used is allocated to size Reg%ntr, which is the total number of tracers + na=2 !number of native MOM6 tracers (T&S) with reservoirs + do m=1,OBC%num_obgc_tracers + !This logic assumes all external tarcers need a reservoir + !The segments for tracers are not initialized yet (that happens later in initialize_segment_data()) + !so we cannot query to determine if this tracer needs a reservoir. + if (segment%is_E_or_W_2) then + OBC%tracer_x_reservoirs_used(m+na) = .true. + else + OBC%tracer_y_reservoirs_used(m+na) = .true. + endif + enddo enddo return @@ -3491,6 +3552,22 @@ function lookup_seg_field(OBC_seg,field) end function lookup_seg_field +!> Return the tracer index from its name +function get_tracer_index(OBC_seg,tr_name) + type(OBC_segment_type), pointer :: OBC_seg !< OBC segment + character(len=*), intent(in) :: tr_name !< The field name + integer :: get_tracer_index, it + get_tracer_index=-1 + it=1 + do while(allocated(OBC_seg%tr_Reg%Tr(it)%t)) + if (trim(OBC_seg%tr_Reg%Tr(it)%name) == trim(tr_name)) then + get_tracer_index=it + exit + endif + it=it+1 + enddo + return +end function get_tracer_index !> Allocate segment data fields subroutine allocate_OBC_segment_data(OBC, segment) @@ -3715,7 +3792,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) type(time_type), intent(in) :: Time !< Model time ! Local variables integer :: c, i, j, k, is, ie, js, je, isd, ied, jsd, jed - integer :: IsdB, IedB, JsdB, JedB, n, m, nz + integer :: IsdB, IedB, JsdB, JedB, n, m, nz, nt type(OBC_segment_type), pointer :: segment => NULL() integer, dimension(4) :: siz real, dimension(:,:,:), pointer :: tmp_buffer_in => NULL() ! Unrotated input [various units] @@ -3810,6 +3887,10 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) allocate(h_stack(GV%ke), source=0.0) do m = 1,segment%num_fields + !This field may not require a high frequency OBC segment update and might be allowed + !a less frequent update as set by the parameter update_OBC_period_max in MOM.F90. + !Cycle if it is not the time to update OBC segment data for this field. + if (trim(segment%field(m)%genre) == 'obgc' .and. (.not. OBC%update_OBC_seg_data)) cycle if (segment%field(m)%fid > 0) then siz(1)=size(segment%field(m)%buffer_src,1) siz(2)=size(segment%field(m)%buffer_src,2) @@ -4173,6 +4254,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! Start second loop to update all fields now that data for all fields are available. ! (split because tides depend on multiple variables). do m = 1,segment%num_fields + !cycle if it is not the time to update OBGC tracers from source + if (trim(segment%field(m)%genre) == 'obgc' .and. (.not. OBC%update_OBC_seg_data)) cycle ! if (segment%field(m)%fid>0) then ! calculate external BT velocity and transport if needed if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then @@ -4359,6 +4442,25 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) else segment%tr_Reg%Tr(2)%OBC_inflow_conc = segment%field(m)%value endif + elseif (trim(segment%field(m)%genre) == 'obgc') then + nt=get_tracer_index(segment,trim(segment%field(m)%name)) + if(nt .lt. 0) then + call MOM_error(FATAL,"update_OBC_segment_data: Did not find tracer "//trim(segment%field(m)%name)) + endif + if (allocated(segment%field(m)%buffer_dst)) then + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + segment%tr_Reg%Tr(nt)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) + enddo ; enddo ; enddo + if (.not. segment%tr_Reg%Tr(nt)%is_initialized) then + !if the tracer reservoir has not yet been initialized, then set to external value. + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + segment%tr_Reg%Tr(nt)%tres(i,j,k) = segment%tr_Reg%Tr(nt)%t(i,j,k) + enddo ; enddo ; enddo + segment%tr_Reg%Tr(nt)%is_initialized=.true. + endif + else + segment%tr_Reg%Tr(nt)%OBC_inflow_conc = segment%field(m)%value + endif endif enddo ! end field loop @@ -4660,6 +4762,123 @@ subroutine register_temp_salt_segments(GV, US, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments +!> Sets the OBC properties of external obgc tracers, such as their source file and field name +subroutine set_obgc_segments_props(OBC,tr_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + type(ocean_OBC_type),pointer :: OBC !< Open boundary structure + character(len=*), intent(in) :: tr_name !< Tracer name + character(len=*), intent(in) :: obc_src_file_name !< OBC source file name + character(len=*), intent(in) :: obc_src_field_name !< name of the field in the source file + real, intent(in) :: lfac_in !< factors for tracer reservoir length scales + real, intent(in) :: lfac_out !< factors for tracer reservoir length scales + + type(external_tracers_segments_props),pointer :: node_ptr => NULL() !pointer to type that keeps + ! the tracer segment properties + allocate(node_ptr) + node_ptr%tracer_name = trim(tr_name) + node_ptr%tracer_src_file = trim(obc_src_file_name) + node_ptr%tracer_src_field = trim(obc_src_field_name) + node_ptr%lfac_in = lfac_in + node_ptr%lfac_out = lfac_out + ! Reversed Linked List implementation! Make this new node to be the head of the list. + node_ptr%next => OBC%obgc_segments_props + OBC%obgc_segments_props => node_ptr + OBC%num_obgc_tracers = OBC%num_obgc_tracers+1 +end subroutine set_obgc_segments_props + +!> Get the OBC properties of external obgc tracers, such as their source file, field name, +!! reservoir length scale factors +subroutine get_obgc_segments_props(node, tr_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + type(external_tracers_segments_props),pointer :: node !< pointer to tracer segment properties + character(len=*), intent(out) :: tr_name !< Tracer name + character(len=*), intent(out) :: obc_src_file_name !< OBC source file name + character(len=*), intent(out) :: obc_src_field_name !< name of the field in the source file + real, intent(out) :: lfac_in !< multiplicative factor for inbound reservoir length scale + real, intent(out) :: lfac_out !< multiplicative factor for outbound reservoir length scale + tr_name = trim(node%tracer_name) + obc_src_file_name = trim(node%tracer_src_file) + obc_src_field_name = trim(node%tracer_src_field) + lfac_in = node%lfac_in + lfac_out = node%lfac_out + node => node%next +end subroutine get_obgc_segments_props + +subroutine register_obgc_segments(GV, OBC, tr_Reg, param_file, tr_name) + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry + type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values + character(len=*), intent(in) :: tr_name!< Tracer name +! Local variables + integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf + integer :: i, j, k, n + type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + type(tracer_type), pointer :: tr_ptr => NULL() + + if (.not. associated(OBC)) return + + do n=1, OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. segment%on_pe) cycle + call tracer_name_lookup(tr_Reg, tr_ptr, tr_name) + call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.True.) + enddo + +end subroutine register_obgc_segments + +subroutine fill_obgc_segments(G, GV, OBC, tr_ptr, tr_name) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + real, dimension(:,:,:), pointer :: tr_ptr !< Pointer to tracer field + character(len=*), intent(in) :: tr_name!< Tracer name +! Local variables + integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz, nt + integer :: i, j, k + type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + real :: I_scale + + if (.not. associated(OBC)) return + call pass_var(tr_ptr, G%Domain) + nz = G%ke + do n=1, OBC%number_of_segments + segment => OBC%segment(n) + if (.not. segment%on_pe) cycle + nt=get_tracer_index(segment,tr_name) + if(nt .lt. 0) then + call MOM_error(FATAL,"fill_obgc_segments: Did not find tracer "// tr_name) + endif + isd = segment%HI%isd ; ied = segment%HI%ied + jsd = segment%HI%jsd ; jed = segment%HI%jed + IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB + JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB + I_scale = 1.0 + if (segment%tr_Reg%Tr(nt)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(nt)%scale + ! Fill with Tracer values + if (segment%is_E_or_W) then + I=segment%HI%IsdB + do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed + if (segment%direction == OBC_DIRECTION_W) then + segment%tr_Reg%Tr(nt)%t(I,j,k) = tr_ptr(i+1,j,k) + else + segment%tr_Reg%Tr(nt)%t(I,j,k) = tr_ptr(i,j,k) + endif + OBC%tres_x(I,j,k,nt) = I_scale * segment%tr_Reg%Tr(nt)%t(I,j,k) + enddo ; enddo + else + J=segment%HI%JsdB + do k=1,nz ; do i=segment%HI%isd,segment%HI%ied + if (segment%direction == OBC_DIRECTION_S) then + segment%tr_Reg%Tr(nt)%t(i,J,k) = tr_ptr(i,j+1,k) + else + segment%tr_Reg%Tr(nt)%t(i,J,k) = tr_ptr(i,j,k) + endif + OBC%tres_y(i,J,k,nt) = I_scale * segment%tr_Reg%Tr(nt)%t(i,J,k) + enddo ; enddo + endif + segment%tr_Reg%Tr(nt)%tres(:,:,:) = segment%tr_Reg%Tr(nt)%t(:,:,:) + enddo +end subroutine fill_obgc_segments + subroutine fill_temp_salt_segments(G, GV, US, OBC, tv) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -5109,7 +5328,6 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! e.g. a_in is -1 only if b_in ==1 and uhr or vhr is inward ! e.g. a_out is 1 only if b_out==1 and uhr or vhr is outward ! It's clear that a_in and a_out cannot be both non-zero [nodim] - nz = GV%ke ntr = Reg%ntr @@ -5140,9 +5358,9 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! When InvLscale_in is 0 and inflow, only nudged data is applied to reservoirs a_out = b_out * max(0.0, sign(1.0, idir*uhr(I,j,k))) a_in = b_in * min(0.0, sign(1.0, idir*uhr(I,j,k))) - u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & + u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out*segment%field(m)%resrv_lfac_out / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) - u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & + u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in*segment%field(m)%resrv_lfac_in / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) fac1 = (1.0 - (a_out - a_in)) + ((u_L_out + a_out) - (u_L_in + a_in)) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1) * & @@ -5171,9 +5389,9 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz a_out = b_out * max(0.0, sign(1.0, jdir*vhr(i,J,k))) a_in = b_in * min(0.0, sign(1.0, jdir*vhr(i,J,k))) - v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & + v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out*segment%field(m)%resrv_lfac_out / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) - v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & + v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in*segment%field(m)%resrv_lfac_in / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) fac1 = 1.0 + (v_L_out-v_L_in) fac1 = (1.0 - (a_out - a_in)) + ((v_L_out + a_out) - (v_L_in + a_in)) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 3cbed68467..4e88944958 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -27,6 +27,7 @@ module MOM_generic_tracer use g_tracer_utils, only: g_tracer_get_next,g_tracer_type,g_tracer_is_prog,g_tracer_flux_init use g_tracer_utils, only: g_tracer_send_diag,g_tracer_get_values use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_tracer_set_csdiag + use g_tracer_utils, only: g_tracer_get_obc_segment_props use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS use MOM_coms, only : EFP_type, max_across_PEs, min_across_PEs, PE_here @@ -39,6 +40,8 @@ module MOM_generic_tracer use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_open_boundary, only : ocean_OBC_type + use MOM_open_boundary, only : register_obgc_segments, fill_obgc_segments + use MOM_open_boundary, only : set_obgc_segments_props use MOM_restart, only : register_restart_field, query_initialized, set_initialized, MOM_restart_CS use MOM_spatial_means, only : global_area_mean, global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS @@ -65,6 +68,7 @@ module MOM_generic_tracer public MOM_generic_flux_init public MOM_generic_tracer_min_max public MOM_generic_tracer_fluxes_accumulate + public register_MOM_generic_tracer_segments !> Control structure for generic tracers type, public :: MOM_generic_tracer_CS ; private @@ -79,7 +83,7 @@ module MOM_generic_tracer type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure - + type(ocean_OBC_type), pointer :: OBC => NULL() ! Pointer to the first element of the linked list of generic tracers. type(g_tracer_type), pointer :: g_tracer_list => NULL() @@ -98,10 +102,9 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer !! advection and diffusion module. type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct - ! Local variables logical :: register_MOM_generic_tracer - + logical :: obc_has ! This include declares and sets the variable "version". # include "version_variable.h" @@ -112,6 +115,8 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) integer :: ntau, axes(3) type(g_tracer_type), pointer :: g_tracer,g_tracer_next character(len=fm_string_len) :: g_tracer_name,longname,units + character(len=fm_string_len) :: obc_src_file_name,obc_src_field_name + real :: lfac_in,lfac_out real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr real, dimension(HI%isd:HI%ied, HI%jsd:HI%jed,GV%ke) :: grid_tmask @@ -156,7 +161,6 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%restart_CSp => restart_CS - ntau=1 ! MOM needs the fields at only one time step @@ -216,6 +220,52 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) register_MOM_generic_tracer = .true. end function register_MOM_generic_tracer + !> Register OBC segments for generic tracers + subroutine register_MOM_generic_tracer_segments(CS, GV, OBC, tr_Reg, param_file) + type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, + !! where, and what open boundary conditions are used. + type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer + !! advection and diffusion module. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + ! Local variables + logical :: obc_has + ! This include declares and sets the variable "version". +# include "version_variable.h" + + character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer_segments' + type(g_tracer_type), pointer :: g_tracer,g_tracer_next + character(len=fm_string_len) :: g_tracer_name + character(len=fm_string_len) :: obc_src_file_name,obc_src_field_name + real :: lfac_in,lfac_out + + if (.NOT. associated(OBC)) return + !Get the tracer list + call generic_tracer_get_list(CS%g_tracer_list) + if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL, trim(sub_name)//& + ": No tracer in the list.") + + g_tracer=>CS%g_tracer_list + do + call g_tracer_get_alias(g_tracer,g_tracer_name) + if (g_tracer_is_prog(g_tracer)) then + call g_tracer_get_obc_segment_props(g_tracer,g_tracer_name,obc_has ,& + obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + if (obc_has) then + call set_obgc_segments_props(OBC,g_tracer_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + call register_obgc_segments(GV, OBC, tr_Reg, param_file, g_tracer_name) + endif + endif + + !traverse the linked list till hit NULL + call g_tracer_get_next(g_tracer, g_tracer_next) + if (.NOT. associated(g_tracer_next)) exit + g_tracer=>g_tracer_next + + enddo + + end subroutine register_MOM_generic_tracer_segments !> Initialize phase II: Initialize required variables for generic tracers !! There are some steps of initialization that cannot be done in register_MOM_generic_tracer !! This is the place and time to do them: @@ -244,7 +294,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, !! ALE sponges. character(len=128), parameter :: sub_name = 'initialize_MOM_generic_tracer' - logical :: OK + logical :: OK,obc_has integer :: i, j, k, isc, iec, jsc, jec, nk type(g_tracer_type), pointer :: g_tracer,g_tracer_next character(len=fm_string_len) :: g_tracer_name @@ -348,6 +398,8 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, call set_initialized(tr_ptr, g_tracer_name, CS%restart_CSp) endif + call g_tracer_get_obc_segment_props(g_tracer,g_tracer_name,obc_has ) + if(obc_has .and. g_tracer_is_prog(g_tracer)) call fill_obgc_segments(G, GV, OBC, tr_ptr, g_tracer_name) !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) if (.NOT. associated(g_tracer_next)) exit diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 1345126d73..af0dded244 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -60,6 +60,7 @@ module MOM_tracer_flow_control use MOM_generic_tracer, only : MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state use MOM_generic_tracer, only : end_MOM_generic_tracer, MOM_generic_tracer_get, MOM_generic_flux_init use MOM_generic_tracer, only : MOM_generic_tracer_stock, MOM_generic_tracer_min_max, MOM_generic_tracer_CS +use MOM_generic_tracer, only : register_MOM_generic_tracer_segments use pseudo_salt_tracer, only : register_pseudo_salt_tracer, initialize_pseudo_salt_tracer use pseudo_salt_tracer, only : pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state use pseudo_salt_tracer, only : pseudo_salt_stock, pseudo_salt_tracer_end, pseudo_salt_tracer_CS @@ -75,6 +76,7 @@ module MOM_tracer_flow_control public call_tracer_register, tracer_flow_control_init, call_tracer_set_forcing public call_tracer_column_fns, call_tracer_surface_state, call_tracer_stocks public call_tracer_flux_init, get_chl_from_model, tracer_flow_control_end +public call_tracer_register_obc_segments !> The control structure for orchestrating the calling of tracer packages type, public :: tracer_flow_control_CS ; private @@ -114,6 +116,7 @@ module MOM_tracer_flow_control contains + !> This subroutine carries out a series of calls to initialize the air-sea !! tracer fluxes, but it does not record the generated indicies, and it may !! be called _before_ the ocean model has been initialized and may be called @@ -163,7 +166,6 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(MOM_restart_CS), intent(inout) :: restart_CS !< A pointer to the restart control !! structure. - ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_tracer_flow_control" ! This module's name. @@ -357,6 +359,26 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag end subroutine tracer_flow_control_init +!> This subroutine calls all registered tracers to register their OBC segments +!! similar to register_temp_salt_segments for T&S +subroutine call_tracer_register_obc_segments(GV, param_file, CS, tr_Reg, OBC) + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(tracer_flow_control_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the + !! control structure for the tracer + !! advection and diffusion module. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition + !! type specifies whether, where, + !! and what open boundary + !! conditions are used. + + if (CS%use_MOM_generic_tracer) & + call register_MOM_generic_tracer_segments(CS%MOM_generic_tracer_CSp, GV, OBC, tr_Reg, param_file) + +end subroutine call_tracer_register_obc_segments !> This subroutine extracts the chlorophyll concentrations from the model state, if possible subroutine get_chl_from_model(Chl_array, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. From f92a4ab7911c108289569b2d781d4db598b3ebbb Mon Sep 17 00:00:00 2001 From: OlgaSergienko <39838355+OlgaSergienko@users.noreply.github.com> Date: Fri, 11 Nov 2022 13:04:44 -0500 Subject: [PATCH 020/213] Ice dynamics (#228) In this PR an option is added to use ice viscosity computed from the observed surface velocity, computed by the model and use a constant value (for debugging purposes). A new (char) parameter "ICE_VISCOSITY_COMPUTE" is introduced; its values can be "MODEL" (the ice viscosity computed by the model); "OBS" the ice viscosity is computed at the preprocessing step and read from a file (its name is defined by the parameter "ICE_STIFFNESS_FILE") into a variable with a name defined by "A_GLEN_VARNAME" parameter; "CONSANT" is a constant value defined by a parameter "A_GLEN". These changes are in MOM_ice_shelf_dynamics.F90. Minor changes are done to MOM_ice_shelf_initialize.F90 to correct units, scales. --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 51 ++++++++++++++-------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 24 +++++----- 2 files changed, 45 insertions(+), 30 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 63ccc3d33c..e605f3e581 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -77,7 +77,8 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: t_shelf => NULL() !< Vertically integrated temperature in the ice shelf/stream, !! on corner-points (B grid) [C ~> degC] real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. - real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, often in [R L4 Z T-1 ~> kg m2 s-1]. + real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity (Pa s), + !! in [R L2 T-1 ~> kg m-1 s-1]. real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity, !! often in [kg-1/3 m-1/3 s-1]. real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. @@ -94,7 +95,7 @@ module MOM_ice_shelf_dynamics !! Sign convention: positive below sea-level, negative above. real, pointer, dimension(:,:) :: basal_traction => NULL() !< The area integrated nonlinear part of "linearized" - !! basal stress [R Z L2 T-1 ~> kg s-1]. + !! basal stress (Pa) [R L2 T-2 ~> Pa]. !! The exact form depends on basal law exponent and/or whether flow is "hybridized" a la Goldberg 2011 real, pointer, dimension(:,:) :: C_basal_friction => NULL()!< Coefficient in sliding law tau_b = C u^(n_basal_fric), !! units= Pa (m yr-1)-(n_basal_fric) @@ -117,6 +118,9 @@ module MOM_ice_shelf_dynamics real :: g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: density_ice !< A typical density of ice [R ~> kg m-3]. + character(len=40) :: ice_viscosity_compute !< Specifies whether the ice viscosity is computed internally + !! according to Glen's flow law; is constant (for debugging purposes) + !! or using observed strain rates and read from a file logical :: GL_regularize !< Specifies whether to regularize the floatation condition !! at the grounding line as in Goldberg Holland Schoof 2009 integer :: n_sub_regularize @@ -261,7 +265,7 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0*US%degC_to_C ) ! [C ~> degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3 s-1] - allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) ! [Pa] allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) @@ -429,6 +433,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "If true, do not allow an ice shelf where prohibited by a mask.", & default=.false.) + call get_param(param_file, mdl, "ICE_VISCOSITY_COMPUTE", CS%ice_viscosity_compute, & + "If MODEL, compute ice viscosity internally, if OBS read from a file,"//& + "if CONSTANT a constant value (for debugging).", & + default="MODEL") endif call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & @@ -581,7 +589,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & - 'vi-viscosity', 'Pa s-1 m', conversion=US%RL2_T2_to_Pa*US%L_T_to_m_s) !vertically integrated viscosity + 'vi-viscosity', 'Pa m s', conversion=US%RL2_T2_to_Pa*US%Z_to_m*US%T_to_s) !vertically integrated viscosity CS%id_taub = register_diag_field('ice_shelf_model','taub_beta',CS%diag%axesT1, Time, & 'taub', 'MPa', conversion=1e-6*US%RL2_T2_to_Pa) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & @@ -1961,13 +1969,12 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif if (CS%ground_frac(i,j) == 1) then -! neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2)) - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 + neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2)) else neumann_val = (.5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2) endif - if ((CS%u_face_mask(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then + if ((CS%u_face_mask_bdry(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then ! left face of the cell is at a stress boundary ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated ! pressure on either side of the face @@ -1981,19 +1988,19 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudx(I-1,J) = taudx(I-1,J) - .5 * dyh * neumann_val endif - if ((CS%u_face_mask(I,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then + if ((CS%u_face_mask_bdry(I,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then ! east face of the cell is at a stress boundary taudx(I,J-1) = taudx(I,J-1) + .5 * dyh * neumann_val taudx(I,J) = taudx(I,J) + .5 * dyh * neumann_val endif - if ((CS%v_face_mask(i,J-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then + if ((CS%v_face_mask_bdry(i,J-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then ! south face of the cell is at a stress boundary taudy(I-1,J-1) = taudy(I-1,J-1) - .5 * dxh * neumann_val taudy(I,J-1) = taudy(I,J-1) - .5 * dxh * neumann_val endif - if ((CS%v_face_mask(i,J) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then + if ((CS%v_face_mask_bdry(i,J) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then ! north face of the cell is at a stress boundary taudy(I-1,J) = taudy(I-1,J) + .5 * dxh * neumann_val taudy(I,J) = taudy(I,J) + .5 * dxh * neumann_val @@ -2560,7 +2567,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, end subroutine apply_boundary_values -!> Update depth integrated viscosity, based on horizontal strain rates, and also update the +!> Update depth integrated viscosity, based on horizontal strain rates subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe @@ -2575,7 +2582,6 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve -! also this subroutine updates the nonlinear part of the basal traction ! this may be subject to change later... to make it "hybrid" ! real, dimension(SZDIB_(G),SZDJB_(G)) :: eII, ux, uy, vx, vy @@ -2609,8 +2615,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) do j=jsc,jec ; do i=isc,iec if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then - Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%AGlen_visc(i,j))**(-1./CS%n_glen) - + Visc_coef = ( (US%RL2_T2_to_Pa)**(-CS%n_glen)*US%T_to_s )**(-1./CS%n_glen) * (CS%AGlen_visc(i,j))**(-1./CS%n_glen) + ! Units of Aglen_visc [Pa-3 s-1] do iq=1,2 ; do jq=1,2 ux = ( (u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & @@ -2633,14 +2639,23 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) enddo ; enddo -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging - CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & - (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif + if (trim(CS%ice_viscosity_compute)=="CONSTANT") then + CS%ice_visc(i,j) =1e15 * US%kg_m3_to_R*US%m_to_L*US%m_s_to_L_T * (G%areaT(i,j) * ISS%h_shelf(i,j)) + ! constant viscocity for debugging + elseif (trim(CS%ice_viscosity_compute)=="MODEL") then + CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & + (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + elseif(trim(CS%ice_viscosity_compute)=="OBS") then + if (CS%AGlen_visc(i,j) >0) CS%ice_visc(i,j) =CS%AGlen_visc(i,j)*(G%areaT(i,j) * ISS%h_shelf(i,j)) + ! Here CS%Aglen_visc(i,j) is the ice viscocity [Pa s-1] computed from obs and read from a file + endif + endif enddo ; enddo deallocate(Phi) end subroutine calc_shelf_visc + +!> Update basal shear subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 618f0e66fe..2de064e93e 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -395,6 +395,8 @@ end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& G, US, PF) +!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,ice_visc,& +! G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: bed_elev !< The bed elevation [Z ~> m]. @@ -402,7 +404,6 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. - real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. [nondim] @@ -450,14 +451,12 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& floatfr_varname = "float_frac" - !### I think that the following two lines should have ..., scale=US%m_s_to_L_T - call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, position=CORNER, scale=1.0) - call MOM_read_data(filename, trim(vshelf_varname), v_shelf, G%Domain, position=CORNER, scale=1.0) -! call MOM_read_data(filename, trim(ice_visc_varname), ice_visc, G%Domain,position=CORNER,scale=1.0) + call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, position=CORNER, scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(vshelf_varname), v_shelf, G%Domain, position=CORNER, scale=US%m_s_to_L_T) call MOM_read_data(filename, trim(floatfr_varname), float_cond, G%Domain, scale=1.) filename = trim(inputdir)//trim(bed_topo_file) - call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.) + call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.0) end subroutine initialize_ice_flow_from_file @@ -543,11 +542,12 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) - call MOM_read_data(filename, trim(ufcmskbdry_varname), u_face_mask_bdry, G%Domain, position=CORNER, scale=1.0) - call MOM_read_data(filename, trim(vfcmskbdry_varname), v_face_mask_bdry, G%Domain, position=CORNER, scale=1.0) - !### I think that the following two lines should have ..., scale=US%m_s_to_L_T - call MOM_read_data(filename, trim(ubdryv_varname), u_bdry_val, G%Domain, position=CORNER, scale=1.0) - call MOM_read_data(filename, trim(vbdryv_varname), v_bdry_val, G%Domain, position=CORNER, scale=1.) + call MOM_read_data(filename, trim(ufcmskbdry_varname), u_face_mask_bdry, G%Domain, position=CORNER, & + scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(vfcmskbdry_varname), v_face_mask_bdry, G%Domain, position=CORNER, & + scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(ubdryv_varname), u_bdry_val, G%Domain, position=CORNER, scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(vbdryv_varname), v_bdry_val, G%Domain, position=CORNER, scale=US%m_s_to_L_T) call MOM_read_data(filename, trim(umask_varname), umask, G%Domain, position=CORNER, scale=1.) call MOM_read_data(filename, trim(vmask_varname), vmask, G%Domain, position=CORNER, scale=1.) filename = trim(inputdir)//trim(icethick_file) @@ -615,7 +615,7 @@ subroutine initialize_ice_C_basal_friction(C_basal_friction, G, US, PF) end subroutine -!> Initialize ice basal friction +!> Initialize ice-stiffness parameter subroutine initialize_ice_AGlen(AGlen, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & From 2b03f95adef2271271c8623fe21c693ce25c92ab Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 Nov 2022 20:49:03 -0500 Subject: [PATCH 021/213] +Set input file variable names via runtime params Added calls to get_param to set 12 input variable names in files via runtime parameters, including TIDEAMP_VARNAME, TEMP_COORD_VAR, SALT_COORD_VAR, THICKNESS_IC_VAR, INTERFACE_IC_RESCALE, TEMP_IC_VAR, SALT_IC_VAR, BASIN_VAR, TIDAL_DISSIPATION_VAR, ROUGHNESS_VARNAME, TIDEAMP_VARNAME and KH_BG_2D_VARNAME. Also added two new runtime parameters, THICKNESS_IC_RESCALE and INTERFACE_IC_RESCALE, to allow input thickness and interface height fields to be rescaled. A number of spelling errors in comments or output messages in the files that were being modified as a part of this commit, including changes in the documentation that appears in MOM_parameter_doc files. All answers are bitwise identical, but there are new entries and minor changes in many MOM_parameter_doc files. --- src/ice_shelf/MOM_ice_shelf.F90 | 41 ++++---- .../MOM_coord_initialization.F90 | 20 ++-- .../MOM_state_initialization.F90 | 64 ++++++++---- src/ocean_data_assim/MOM_oda_driver.F90 | 16 +-- .../lateral/MOM_hor_visc.F90 | 33 ++++--- .../lateral/MOM_internal_tides.F90 | 98 +++++++------------ .../vertical/MOM_internal_tide_input.F90 | 17 +++- .../vertical/MOM_set_viscosity.F90 | 32 +++--- .../vertical/MOM_tidal_mixing.F90 | 66 ++++++++----- 9 files changed, 215 insertions(+), 172 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 26c74d73ec..1a29ef45e6 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -139,7 +139,7 @@ module MOM_ice_shelf real :: time_step !< this is the shortest timestep that the ice shelf sees [T ~> s], and !! is equal to the forcing timestep (it is passed in when the shelf !! is initialized - so need to reorganize MOM driver. - !! it will be the prognistic timestep ... maybe. + !! it will be the prognostic timestep ... maybe. logical :: solo_ice_sheet !< whether the ice model is running without being !! coupled to the ocean @@ -288,13 +288,13 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: n_star_term ! A term in the expression for nstar [T3 Z-2 ~> s3 m-2] real :: absf ! The absolute value of the Coriolis parameter [T-1 ~> s-1] real :: dIns_dwB !< The partial derivative of I_n_star with wB_flux, in [T3 Z-2 ~> s3 m-2] - real :: dT_ustar ! The difference between the the freezing point and the ocean boundary layer + real :: dT_ustar ! The difference between the freezing point and the ocean boundary layer ! temperature times the friction velocity [C Z T-1 ~> degC m s-1] real :: dS_ustar ! The difference between the salinity at the ice-ocean interface and the ocean ! boundary layer salinity times the friction velocity [S Z T-1 ~> ppt m s-1] real :: ustar_h ! The friction velocity in the water below the ice shelf [Z T-1 ~> m s-1] real :: Gam_turb ! [nondim] - real :: Gam_mol_t, Gam_mol_s ! Relative coefficients of molecular diffusivites [nondim] + real :: Gam_mol_t, Gam_mol_s ! Relative coefficients of molecular diffusivities [nondim] real :: RhoCp ! A typical ocean density times the heat capacity of water [Q R C-1 ~> J m-3 degC-1] real :: ln_neut real :: mass_exch ! A mass exchange rate [R Z T-1 ~> kg m-2 s-1] @@ -312,7 +312,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: Irho0 ! The inverse of the mean density times a unit conversion factor [R-1 L Z-1 ~> m3 kg-1] logical :: Sb_min_set, Sb_max_set logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. - logical :: coupled_GL ! If true, the grouding line position is determined based on + logical :: coupled_GL ! If true, the grounding line position is determined based on ! coupled ice-ocean dynamics. real, parameter :: c2_3 = 2.0/3.0 @@ -524,7 +524,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) wB_flux = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * wT_flux if (wB_flux < 0.0) then - ! The buoyancy flux is stabilizing and will reduce the tubulent + ! The buoyancy flux is stabilizing and will reduce the turbulent ! fluxes, and iteration is required. n_star_term = (ZETA_N/RC) * (hBL_neut * VK) / (ustar_h)**3 do it3 = 1,30 @@ -572,9 +572,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) exch_vel_s(i,j) = ustar_h * I_Gam_S ! Calculate the heat flux inside the ice shelf. - ! Vertical adv/diff as in H+J 1999, eqns (26) & approx from (31). + ! Vertical adv/diff as in H+J 1999, equations (26) & approx from (31). ! Q_ice = density_ice * CS%Cp_ice * K_ice * dT/dz (at interface) - ! vertical adv/diff as in H+J 1999, eqs (31) & (26)... + ! vertical adv/diff as in H+J 1999, equations (31) & (26)... ! dT/dz ~= min( (lprec/(density_ice*K_ice))*(CS%Temp_Ice-T_freeze) , 0.0 ) ! If this approximation is not made, iterations are required... See H+J Fig 3. @@ -1012,7 +1012,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes) real :: balancing_area !< total area where the balancing flux is applied [m2] type(time_type) :: dTime !< The time step as a time_type type(time_type) :: Time0 !< The previous time (Time-dt) - real, dimension(SZDI_(G),SZDJ_(G)) :: bal_frac !< Fraction of the cel1 where the mass flux + real, dimension(SZDI_(G),SZDJ_(G)) :: bal_frac !< Fraction of the cell where the mass flux !! balancing the net melt flux occurs, 0 to 1 [nondim] real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass !! at at previous time (Time-dt) [R Z ~> kg m-2] @@ -1235,13 +1235,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, logical :: new_sim, save_IC !This include declares and sets the variable "version". # include "version_variable.h" - character(len=200) :: IC_file, inputdir + character(len=200) :: IC_file, inputdir ! Input file names or paths character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq integer :: wd_halos(2) logical :: read_TideAmp, shelf_mass_is_dynamic, debug logical :: global_indexing - character(len=240) :: Tideamp_file + character(len=240) :: Tideamp_file ! Input file names + character(len=80) :: tideamp_var ! Input file variable names real :: utide ! A tidal velocity [L T-1 ~> m s-1] real :: col_thick_melt_thresh ! An ocean column thickness below which iceshelf melting ! does not occur [Z ~> m] @@ -1397,7 +1398,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "consistency to calculate the fluxes at the ice-ocean "//& "interface.", default=.true.) call get_param(param_file, mdl, "SHELF_INSULATOR", CS%insulator, & - "If true, the ice shelf is a perfect insulatior "//& + "If true, the ice shelf is a perfect insulator "//& "(no conduction).", default=.false.) call get_param(param_file, mdl, "MELTING_CUTOFF_DEPTH", CS%cutoff_depth, & "Depth above which the melt is set to zero (it must be >= 0) "//& @@ -1491,7 +1492,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "The viscosity of the ice.", & units="m2 s-1", default=1.0e10, scale=US%Z_to_L**2*US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KV_MOLECULAR", CS%kv_molec, & - "The molecular kinimatic viscosity of sea water at the freezing temperature.", & + "The molecular kinematic viscosity of sea water at the freezing temperature.", & units="m2 s-1", default=1.95e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "ICE_SHELF_SALINITY", CS%Salin_ice, & "The salinity of the ice inside the ice shelf.", & @@ -1537,19 +1538,21 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, if (read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying "//& - "tidal amplitudes.", & + "The path to the file containing the spatially varying tidal amplitudes.", & default="tideamp.nc") - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) TideAmp_file = trim(inputdir) // trim(TideAmp_file) if (CS%rotate_index) then allocate(tmp2d(CS%Grid_in%isd:CS%Grid_in%ied,CS%Grid_in%jsd:CS%Grid_in%jed), source=0.0) - call MOM_read_data(TideAmp_file, 'tideamp', tmp2d, CS%Grid_in%domain, timelevel=1, scale=US%m_s_to_L_T) + call MOM_read_data(TideAmp_file, tideamp_var, tmp2d, CS%Grid_in%domain, timelevel=1, scale=US%m_s_to_L_T) call rotate_array(tmp2d, CS%turns, CS%utide) deallocate(tmp2d) else - call MOM_read_data(TideAmp_file, 'tideamp', CS%utide, CS%Grid%domain, timelevel=1, scale=US%m_s_to_L_T) + call MOM_read_data(TideAmp_file, tideamp_var, CS%utide, CS%Grid%domain, timelevel=1, scale=US%m_s_to_L_T) endif else call get_param(param_file, mdl, "UTIDE", utide, & @@ -2192,7 +2195,7 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in real :: min_time_step ! The minimal required timestep that would indicate a fatal problem [T ~> s] character(len=240) :: mesg logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. - logical :: coupled_GL ! If true the grouding line position is determined based on + logical :: coupled_GL ! If true the grounding line position is determined based on ! coupled ice-ocean dynamics. integer :: is, iec, js, jec @@ -2261,7 +2264,7 @@ end subroutine solo_step_ice_shelf !! update_shelf_mass - updates ice shelf mass via netCDF file !! USER_update_shelf_mass (TODO). !! solo_step_ice_shelf - called only in ice-only mode. -!! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. currently mass_shelf is +!! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. Currently mass_shelf is !! updated immediately after ice_shelf_advect in fully dynamic mode. !! !! NOTES: be aware that hmask(:,:) has a number of functions; it is used for front advancement, diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 91b30a1e86..66c09cb6a3 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -261,6 +261,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s integer :: k, nz character(len=40) :: mdl = "set_coord_from_TS_profile" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path + character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files + nz = GV%ke call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") @@ -269,15 +271,21 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & - "The file from which the coordinate temperatures and "//& - "salinities are read.", fail_if_missing=.true.) + "The file from which the coordinate temperatures and salinities are read.", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "TEMP_COORD_VAR", temp_var, & + "The coordinate reference profile variable name for potential temperature.", & + default="PTEMP") + call get_param(param_file, mdl, "SALT_COORD_VAR", salt_var, & + "The coordinate reference profile variable name for salinity.", & + default="SALT") call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") filename = trim(slasher(inputdir))//trim(coord_file) call log_param(param_file, mdl, "INPUTDIR/COORD_FILE", filename) - call MOM_read_data(filename, "PTEMP", T0(:), scale=US%degC_to_C) - call MOM_read_data(filename, "SALT", S0(:), scale=US%ppt_to_S) + call MOM_read_data(filename, temp_var, T0(:), scale=US%degC_to_C) + call MOM_read_data(filename, salt_var, S0(:), scale=US%ppt_to_S) if (.not.file_exists(filename)) call MOM_error(FATAL, & " set_coord_from_TS_profile: Unable to open " //trim(filename)) @@ -357,7 +365,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta k_light = GV%nk_rho_varies + 1 - ! Set T0(k) to range from T_LIGHT to T_DENSE, and simliarly for S0(k). + ! Set T0(k) to range from T_LIGHT to T_DENSE, and similarly for S0(k). T0(k_light) = T_Light ; S0(k_light) = S_Light a1 = 2.0 * res_rat / (1.0 + res_rat) do k=k_light+1,nz @@ -458,7 +466,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m) - ! This following sets the target layer densities such that a the + ! This following sets the target layer densities such that the ! surface interface has density Rlay_ref and the bottom ! is Rlay_range larger do k=1,nz diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 31dbb41dcc..0cd94d1e79 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -135,7 +135,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !! for model parameter values. type(directories), intent(in) :: dirs !< A structure containing several relevant !! directory paths. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure type(ALE_CS), pointer :: ALE_CSp !< The ALE control structure for remapping type(tracer_registry_type), pointer :: tracer_Reg !< A pointer to the tracer registry type(sponge_CS), pointer :: sponge_CSp !< The layerwise sponge control structure. @@ -342,7 +342,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! Initialize temperature and salinity (T and S). if ( use_temperature ) then call get_param(PF, mdl, "TS_CONFIG", config, & - "A string that determines how the initial tempertures "//& + "A string that determines how the initial temperatures "//& "and salinities are specified for a new run: \n"//& " \t file - read velocities from the file specified \n"//& " \t\t by (TS_FILE). \n"//& @@ -471,7 +471,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "file is read.", default=.not.GV%Boussinesq, do_not_log=just_read) if (new_sim .and. convert .and. .not.GV%Boussinesq) & - ! Convert thicknesses from geomtric distances to mass-per-unit-area. + ! Convert thicknesses from geometric distances to mass-per-unit-area. call convert_thickness(h, G, GV, US, tv) ! Remove the mass that would be displaced by an ice shelf or inverse barometer. @@ -684,12 +684,18 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. + real :: h_rescale ! A factor by which to rescale the initial thickness variable in the input + ! file to convert it to units of m [various] + real :: eta_rescale ! A factor by which to rescale the initial interface heights to convert + ! them to units of m or correct sign conventions to positive upward [various] + real :: h_tolerance ! A parameter that controls the tolerance when adjusting the + ! thickness to fit the bathymetry [Z ~> m]. integer :: inconsistent = 0 logical :: correct_thickness - real :: h_tolerance ! A parameter that controls the tolerance when adjusting the - ! thickness to fit the bathymetry [Z ~> m]. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path + character(len=80) :: eta_var ! The interface height variable name in the input file + character(len=80) :: h_var ! The thickness variable name in the input file integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -710,9 +716,16 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f " initialize_thickness_from_file: Unable to open "//trim(filename)) if (file_has_thickness) then - !### Consider adding a parameter to use to rescale h. + call get_param(param_file, mdl, "THICKNESS_IC_VAR", h_var, & + "The variable name for layer thickness initial conditions.", & + default="h", do_not_log=just_read) + call get_param(param_file, mdl, "THICKNESS_IC_RESCALE", h_rescale, & + "A factor by which to rescale the initial thicknesses in the input "//& + "file to convert them to units of m.", & + default=1.0, units="various", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H) + + call MOM_read_data(filename, h_var, h(:,:,:), G%Domain, scale=h_rescale*GV%m_to_H) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the "//& @@ -724,9 +737,17 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) endif + call get_param(param_file, mdl, "INTERFACE_IC_VAR", eta_var, & + "The variable name for initial conditions for interface heights "//& + "relative to mean sea level, positive upward unless otherwise rescaled.", & + default="eta", do_not_log=just_read) + call get_param(param_file, mdl, "INTERFACE_IC_RESCALE", eta_rescale, & + "A factor by which to rescale the initial interface heights to convert "//& + "them to units of m or correct sign conventions to positive upward.", & + default=1.0, units="various", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=US%m_to_Z) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z*eta_rescale) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, US, eta, h, h_tolerance, dZ_ref_eta=G%Z_ref) @@ -868,7 +889,7 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (G%max_depth<=0.) call MOM_error(FATAL,"initialize_thickness_uniform: "// & - "MAXIMUM_DEPTH has a non-sensical value! Was it set?") + "MAXIMUM_DEPTH has a nonsensical value! Was it set?") do k=1,nz e0(K) = -G%max_depth * real(k-1) / real(nz) @@ -915,7 +936,7 @@ subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_r real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path - character(len=72) :: eta_var + character(len=72) :: eta_var ! The interface height variable name in the input file integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1681,13 +1702,20 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, US, param_file, just_r real, dimension(SZK_(GV)) :: T0, S0 integer :: i, j, k character(len=200) :: filename, ts_file, inputdir ! Strings for file/path + character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files character(len=40) :: mdl = "initialize_temp_salt_from_profile" if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & - "The file with the reference profiles for temperature "//& - "and salinity.", fail_if_missing=.not.just_read, do_not_log=just_read) + "The file with the reference profiles for temperature and salinity.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "TEMP_IC_VAR", temp_var, & + "The initial condition variable for potential temperature.", & + default="PTEMP", do_not_log=just_read) + call get_param(param_file, mdl, "SALT_IC_VAR", salt_var, & + "The initial condition variable for salinity.", & + default="SALT", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1695,12 +1723,12 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, US, param_file, just_r inputdir = slasher(inputdir) filename = trim(inputdir)//trim(ts_file) call log_param(param_file, mdl, "INPUTDIR/TS_FILE", filename) - if (.not.file_exists(filename)) call MOM_error(FATAL, & + if (.not.file_exists(filename)) call MOM_error(FATAL, & " initialize_temp_salt_from_profile: Unable to open "//trim(filename)) ! Read the temperatures and salinities from a netcdf file. - call MOM_read_data(filename, "PTEMP", T0(:), scale=US%degC_to_C) - call MOM_read_data(filename, "SALT", S0(:), scale=US%ppt_to_S) + call MOM_read_data(filename, temp_var, T0(:), scale=US%degC_to_C) + call MOM_read_data(filename, salt_var, S0(:), scale=US%ppt_to_S) do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) @@ -2212,14 +2240,14 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(oda_incupd_CS), pointer :: oda_incupd_CSp !< A pointer that is set to point to the control !! structure for this module. - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in !! overrides any value set for !Time. ! Local variables real, allocatable, dimension(:,:,:) :: hoda ! The layer thk inc. and oda layer thk [H ~> m or kg m-2]. real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading oda fields - real, allocatable, dimension(:,:,:) :: tmp_u,tmp_v ! A temporary array for reading oda fields + real, allocatable, dimension(:,:,:) :: tmp_u, tmp_v ! Temporary arrays for reading oda fields integer :: is, ie, js, je, nz integer :: isd, ied, jsd, jed @@ -2605,7 +2633,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "latter takes precedence.", default=default_remap_ans_date, do_not_log=just_read) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & - "If true, use the order of arithmetic for horizonal regridding that recovers "//& + "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) ! Revise inconsistent default answer dates for horizontal regridding. diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index fd49ec5a98..c48324962b 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -174,6 +174,7 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) integer :: npes_pm, ens_info(6) character(len=30) :: coord_mode character(len=200) :: inputdir, basin_file + character(len=80) :: basin_var character(len=80) :: remap_scheme character(len=80) :: bias_correction_file, inc_file logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the @@ -348,27 +349,28 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) if (CS%use_basin_mask) then call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & - "A file in which to find the basin masks, in variable 'basin'.", & - default="basin.nc") + "A file in which to find the basin masks.", default="basin.nc") basin_file = trim(inputdir) // trim(basin_file) + call get_param(PF, 'oda_driver', "BASIN_VAR", basin_var, & + "The basin mask variable in BASIN_FILE.", default="basin") allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed), source=0.0) - call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) + call MOM_read_data(basin_file, basin_var, CS%oda_grid%basin_mask, CS%Grid%domain, timelevel=1) endif ! set up diag variables for analysis increments CS%diag_CS => diag_CS - CS%id_inc_t=register_diag_field('ocean_model','temp_increment',diag_CS%axesTL,& + CS%id_inc_t = register_diag_field('ocean_model', 'temp_increment', diag_CS%axesTL, & Time, 'ocean potential temperature increments', 'degC', conversion=US%C_to_degC) - CS%id_inc_s=register_diag_field('ocean_model','salt_increment',diag_CS%axesTL,& + CS%id_inc_s = register_diag_field('ocean_model', 'salt_increment', diag_CS%axesTL, & Time, 'ocean salinity increments', 'psu', conversion=US%S_to_ppt) !! get global grid information from ocean model needed for ODA initialization - T_grid=>NULL() + T_grid => NULL() call set_up_global_tgrid(T_grid, CS, G) call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) deallocate(T_grid) - CS%Time=Time + CS%Time = Time !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4339a699e5..825ca412d1 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -182,9 +182,9 @@ module MOM_hor_visc type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics ! real, allocatable :: hf_diffu(:,:,:) ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, allocatable :: hf_diffv(:,:,:) ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffv(:,:,:) ! Meridional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. ! 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. + ! The code is retained for debugging purposes in the future. integer :: num_smooth_gme !< number of smoothing passes for the GME fluxes. !>@{ @@ -252,13 +252,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] + Del2u, & ! The u-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - Del2v, & ! The v-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] + Del2v, & ! The v-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] @@ -345,7 +345,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] - real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] + real :: DX_dyBu ! Ratio of zonal over meridional grid spacing at vertices [nondim] real :: Sh_F_pow ! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim] real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter ! calculation gives the same value as if f were 0 [nondim]. @@ -1682,7 +1682,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. - type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v @@ -1705,8 +1705,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity [L2 T-1 ~> m2 s-1] real :: Ah ! biharmonic horizontal viscosity [L4 T-1 ~> m4 s-1] - real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc + real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Laplacian viscosity + real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives biharmonic viscosity real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant @@ -1730,7 +1730,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) ! forms of the same expressions. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags - character(len=64) :: inputdir, filename + character(len=200) :: inputdir, filename ! Input file names and paths + character(len=80) :: Kh_var ! Input variable names real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine real :: aniso_grid_dir(2) ! Vector (n1,n2) for anisotropic direction @@ -1851,24 +1852,24 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & do_not_log=.not.CS%anisotropic) call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & - "Selects the mode for setting the direction of anistropy.\n"//& + "Selects the mode for setting the direction of anisotropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& "\t 1 - Points towards East.\n"//& "\t 2 - Points along the flow direction, U/|U|.", & default=0, do_not_log=.not.CS%anisotropic) if (aniso_mode == 0) then call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "The vector pointing in the direction of anisotropy for horizontal viscosity. "//& "n1,n2 are the i,j components relative to the grid.", & units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) elseif (aniso_mode == 1) then call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "The vector pointing in the direction of anisotropy for horizontal viscosity. "//& "n1,n2 are the i,j components relative to the spherical coordinates.", & units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) else call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for horizontal viscosity.", & + "The vector pointing in the direction of anisotropy for horizontal viscosity.", & units="nondim", fail_if_missing=.false., do_not_log=.true.) endif @@ -2074,11 +2075,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & 'The filename containing a 2d map of "Kh".', & default='KH_background_2d.nc', do_not_log=.not.CS%use_Kh_bg_2d) + call get_param(param_file, mdl, "KH_BG_2D_VARNAME", Kh_var, & + 'The name in the input file of the horizontal viscosity variable.', & + default='Kh', do_not_log=.not.CS%use_Kh_bg_2d) + if (CS%use_Kh_bg_2d) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 - call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & + call MOM_read_data(trim(inputdir)//trim(filename), Kh_var, CS%Kh_bg_2d, & G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index b152583269..8414e27f8c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -83,7 +83,7 @@ module MOM_internal_tides !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss !< internal tide energy loss due to the residual at slopes [R Z3 T-3 ~> W m-2] - real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, + real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc background processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] @@ -124,7 +124,7 @@ module MOM_internal_tides type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(wave_structure_CS) :: wave_struct !< Wave structure control struct + type(wave_structure_CS) :: wave_struct !< Wave structure control structure !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles @@ -135,7 +135,7 @@ module MOM_internal_tides ! Diag handles considering: sums over all modes, frequencies, and angles integer :: id_tot_leak_loss = -1, id_tot_quad_loss = -1, id_tot_itidal_loss = -1 integer :: id_tot_Froude_loss = -1, id_tot_residual_loss = -1, id_tot_allprocesses_loss = -1 - ! Diag handles considering: all modes & freqs; summed over angles + ! Diag handles considering: all modes & frequencies; summed over angles integer, allocatable, dimension(:,:) :: & id_En_mode, & id_itidal_loss_mode, & @@ -177,7 +177,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Length of time over which to advance !! the internal tides [T ~> s]. - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure real, dimension(SZI_(G),SZJ_(G),CS%nMode), & intent(in) :: cn !< The internal wave speeds of each !! mode [L T-1 ~> m s-1]. @@ -540,7 +540,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call enable_averages(dt, time_end, CS%diag) if (query_averaging_enabled(CS%diag)) then - ! Output two-dimensional diagnostistics + ! Output two-dimensional diagnostics if (CS%id_tot_En > 0) call post_data(CS%id_tot_En, tot_En, CS%diag) if (CS%id_itide_drag > 0) call post_data(CS%id_itide_drag, drag_scale, CS%diag) if (CS%id_TKE_itidal_input > 0) call post_data(CS%id_TKE_itidal_input, & @@ -645,7 +645,7 @@ end subroutine propagate_int_tide subroutine sum_En(G, US, CS, En, label) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), & intent(in) :: En !< The energy density of the internal tides [R Z3 T-2 ~> J m-2]. character(len=*), intent(in) :: label !< A label to use in error messages @@ -684,7 +684,7 @@ end subroutine sum_En subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & @@ -700,16 +700,16 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, !! (q*rho*kappa*h^2*N*U^2). real, intent(in) :: dt !< Time increment [T ~> s]. logical,optional, intent(in) :: full_halos !< If true, do the calculation over the - !! entirecomputational domain. + !! entire computational domain. ! Local variables integer :: j,i,m,fr,a, is, ie, js, je real :: En_tot ! energy for a given mode, frequency, and point summed over angles [R Z3 T-2 ~> J m-2] real :: TKE_loss_tot ! dissipation for a given mode, frequency, and point summed over angles [R Z3 T-3 ~> W m-2] - real :: frac_per_sector ! fraction of energy in each wedge + real :: frac_per_sector ! fraction of energy in each wedge [nondim] real :: q_itides ! fraction of energy actually lost to mixing (remainder, 1-q, is - ! assumed to stay in propagating mode for now - BDM) + ! assumed to stay in propagating mode for now - BDM) [nondim] real :: loss_rate ! approximate loss rate for implicit calc [T-1 ~> s-1] - real :: En_negl ! negilibly small number to prevent division by zero + real :: En_negl ! negligibly small number to prevent division by zero [R Z3 T-2 ~> J m-2] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -753,7 +753,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, ! if (TKE_loss(i,j,a,fr,m)*dt <= En(i,j,a,fr,m))then ! En(i,j,a,fr,m) = En(i,j,a,fr,m) - TKE_loss(i,j,a,fr,m)*dt ! else - ! call MOM_error(WARNING, "itidal_lowmode_loss: energy loss greater than avalable, "// & + ! call MOM_error(WARNING, "itidal_lowmode_loss: energy loss greater than available, "// & ! " setting En to zero.", all_print=.true.) ! En(i,j,a,fr,m) = 0.0 ! endif @@ -775,7 +775,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) integer, intent(in) :: i !< The i-index of the value to be reported. integer, intent(in) :: j !< The j-index of the value to be reported. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified !! mechanism [R Z3 T-3 ~> W m-2]. @@ -950,7 +950,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) real :: flux real :: u_ang ! Angular propagation speed [Rad T-1 ~> Rad s-1] real :: Angle_size ! The size of each orientation wedge in radians [Rad] - real :: I_Angle_size ! The inverse of the the orientation wedges [Rad-1] + real :: I_Angle_size ! The inverse of the orientation wedges [Rad-1] real :: I_dt ! The inverse of the timestep [T-1 ~> s-1] real :: aR, aL ! Left and right edge estimates of energy density [R Z3 T-2 rad-1 ~> J m-2 rad-1] real :: Ep, Ec, Em ! Mean angular energy density for three successive wedges in angular @@ -1037,7 +1037,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss) real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: residual_loss !< internal tide energy loss due !! to the residual at slopes [R Z3 T-3 ~> W m-2]. @@ -1166,7 +1166,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, intent(in) :: dt !< Time increment [T ~> s]. - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables integer :: i, j, ish, ieh, jsh, jeh, m @@ -1452,7 +1452,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: residual_loss !< internal tide energy loss due @@ -1533,7 +1533,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, res !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: residual_loss !< internal tide energy loss due @@ -1699,7 +1699,7 @@ subroutine reflect(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables @@ -1806,7 +1806,7 @@ subroutine teleport(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c @@ -1831,7 +1831,7 @@ subroutine teleport(En, NAngle, CS, G, LB) ! ! (values exclude halos) integer :: ish, ieh, jsh, jeh ! start and end local indices on data domain ! leaving out outdated halo points (march in) - integer :: id_g, jd_g ! global (decomp-invar) indices + integer :: id_g, jd_g ! global (decomposition-invariant) indices integer :: jos, ios ! offsets real :: cos_normal, sin_normal, angle_wall ! cos/sin of cross-ridge normal, ridge angle @@ -2144,8 +2144,8 @@ end subroutine PPM_limit_pos ! subroutine register_int_tide_restarts(G, param_file, CS, restart_CS) ! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! type(int_tide_CS), intent(in) :: CS !< Internal tide control struct -! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct +! type(int_tide_CS), intent(in) :: CS !< Internal tide control structure +! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! ! This subroutine is not currently in use!! @@ -2189,7 +2189,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure ! Local variables real :: Angle_size ! size of wedges, rad @@ -2216,8 +2216,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) character(len=200) :: refl_angle_file character(len=200) :: refl_pref_file, refl_dbl_file, trans_file character(len=200) :: h2_file - !character(len=200) :: land_mask_file - !character(len=200) :: dy_Cu_file, dx_Cv_file + character(len=80) :: rough_var ! Input file variable names isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2389,11 +2388,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) + call get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & + "The name in the input file of the squared sub-grid-scale "//& + "topographic roughness amplitude variable.", default="h2") call get_param(param_file, mdl, "INTERNAL_TIDE_ROUGHNESS_FRAC", RMS_roughness_frac, & "The maximum RMS topographic roughness as a fraction of the nominal ocean depth, "//& "or a negative value for no limit.", units="nondim", default=0.1) - call MOM_read_data(filename, 'h2', h2, G%domain, scale=US%m_to_Z**2) + call MOM_read_data(filename, rough_var, h2, G%domain, scale=US%m_to_Z**2) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict RMS topographic roughness to a fraction (10 percent by default) of the column depth. if (RMS_roughness_frac >= 0.0) then @@ -2502,40 +2504,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo call pass_var(CS%residual,G%domain) - ! Read in prescribed land mask from file (if overwriting -BDM). - ! This should be done in MOM_initialize_topography subroutine - ! defined in MOM_fixed_initialization.F90 (BDM) - !call get_param(param_file, mdl, "LAND_MASK_FILE", land_mask_file, & - ! "The path to the file containing the land mask.", & - ! fail_if_missing=.false.) - !filename = trim(CS%inputdir) // trim(land_mask_file) - !call log_param(param_file, mdl, "INPUTDIR/LAND_MASK_FILE", filename) - !G%mask2dCu(:,:) = 1 ; G%mask2dCv(:,:) = 1 ; G%mask2dT(:,:) = 1 - !call MOM_read_data(filename, 'land_mask', G%mask2dCu, G%domain) - !call MOM_read_data(filename, 'land_mask', G%mask2dCv, G%domain) - !call MOM_read_data(filename, 'land_mask', G%mask2dT, G%domain) - !call pass_vector(G%mask2dCu, G%mask2dCv, G%domain, To_All+Scalar_Pair, CGRID_NE) - !call pass_var(G%mask2dT,G%domain) - - ! Read in prescribed partial east face blockages from file (if overwriting -BDM) - !call get_param(param_file, mdl, "dy_Cu_FILE", dy_Cu_file, & - ! "The path to the file containing the east face blockages.", & - ! fail_if_missing=.false.) - !filename = trim(CS%inputdir) // trim(dy_Cu_file) - !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) - !G%dy_Cu(:,:) = 0.0 - !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, scale=US%m_to_L) - - ! Read in prescribed partial north face blockages from file (if overwriting -BDM) - !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & - ! "The path to the file containing the north face blockages.", & - ! fail_if_missing=.false.) - !filename = trim(CS%inputdir) // trim(dx_Cv_file) - !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) - !G%dx_Cv(:,:) = 0.0 - !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, scale=US%m_to_L) - !call pass_vector(G%dy_Cu, G%dx_Cv, G%domain, To_All+Scalar_Pair, CGRID_NE) - ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & Time, 'Local angle of coastline/ridge/shelf with respect to equator', 'rad') @@ -2604,7 +2572,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Angle_size = (8.0*atan(1.0)) / (real(num_angle)) do a=1,num_angle ; angles(a) = (real(a) - 1) * Angle_size ; enddo - id_ang = diag_axis_init("angle", angles, "Radians", "N", "Angular Orienation of Fluxes") + id_ang = diag_axis_init("angle", angles, "Radians", "N", "Angular Orientation of Fluxes") call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), id_ang /), & axes_ang, is_h_point=.true.) do fr=1,CS%nFreq ; write(freq_name(fr), '("freq",i1)') fr ; enddo @@ -2645,16 +2613,16 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) axes_ang, Time, var_descript, 'W m-2 band-1', conversion=US%RZ3_T3_to_W_m2) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D period-averaged near-bottom horizonal velocity for each freq and mode + ! Register 2-D period-averaged near-bottom horizontal velocity for each freq and mode write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m - write(var_descript, '("Near-bottom horizonal velocity for frequency ",i1," mode ",i1)') fr, m + write(var_descript, '("Near-bottom horizontal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 2-D horizonal phase velocity for each freq and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m - write(var_descript, '("Horizonal phase velocity for frequency ",i1," mode ",i1)') fr, m + write(var_descript, '("Horizontal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index ff2180497b..9ec4c073f0 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -185,7 +185,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) !! smooth out the values in thin layers [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy frequency at the !! ocean bottom [T-2 ~> s-2]. ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -304,7 +304,8 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_int_tide_input" ! This module's name. - character(len=200) :: filename, tideamp_file, h2_file + character(len=200) :: filename, tideamp_file, h2_file ! Input file names or paths + character(len=80) :: tideamp_var, rough_var ! Input file variable names real :: mask_itidal ! A multiplicative land mask, 0 or 1 [nondim] real :: max_frac_rough ! The fraction relating the maximum topographic roughness @@ -386,7 +387,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', itide%tideamp, G%domain, scale=US%m_s_to_L_T) + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") + call MOM_read_data(filename, tideamp_var, itide%tideamp, G%domain, scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -395,7 +399,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', itide%h2, G%domain, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & + "The name in the input file of the squared sub-grid-scale "//& + "topographic roughness amplitude variable.", default="h2") + call MOM_read_data(filename, rough_var, itide%h2, G%domain, scale=US%m_to_Z**2) call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& @@ -408,7 +415,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) default=.false.) if (CS%int_tide_source_test)then call get_param(param_file, mdl, "INTERNAL_TIDE_USE_GLOB_IJ", CS%int_tide_use_glob_ij, & - "Use global IJ for interal tide generation source test", default=.false.) + "Use global IJ for internal tide generation source test", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1., & do_not_log=CS%int_tide_use_glob_ij) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 80be1ed12f..1d2bbbb048 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -77,7 +77,7 @@ module MOM_set_visc logical :: Channel_drag !< If true, the drag is exerted directly on each layer !! according to what fraction of the bottom they overlie. real :: Chan_drag_max_vol !< The maximum bottom boundary layer volume within which the - !! channel drag is applied, normalized by the the full cell area, + !! channel drag is applied, normalized by the full cell area, !! or a negative value to apply no maximum [H ~> m or kg m-2]. logical :: correct_BBL_bounds !< If true, uses the correct bounds on the BBL thickness and !! viscosity so that the bottom layer feels the intended drag. @@ -134,7 +134,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs. + !! have NULL pointers. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous @@ -1192,7 +1192,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have - !! NULL ptrs. + !! NULL pointers. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. @@ -1236,7 +1236,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) ! viscous mixed layer. real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the - ! interior layer layer times the depth of the the mixed layer + ! interior layer layer times the depth of the mixed layer ! [H2 L2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate @@ -1253,8 +1253,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) real :: S_lay ! The layer salinity at velocity points [S ~> ppt]. real :: Rlay ! The layer potential density at velocity points [R ~> kg m-3]. real :: Rlb ! The potential density of the layer below [R ~> kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. - real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> m s-1]. + real :: v_at_u ! The meridional velocity at a zonal velocity point [L T-1 ~> m s-1]. + real :: u_at_v ! The zonal velocity at a meridional velocity point [L T-1 ~> m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. @@ -1863,7 +1863,7 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1954,14 +1954,14 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! output. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. Allocated here. - type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control struct - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables real :: Csmag_chan_dflt ! The default value for SMAG_CONST_CHANNEL [nondim] real :: smag_const1 ! The default value for the Smagorinsky Laplacian coefficient [nondim] - real :: TKE_decay_dflt ! The default value of a coeficient scaling the vertical decay + real :: TKE_decay_dflt ! The default value of a coefficient scaling the vertical decay ! rate of TKE [nondim] real :: bulk_Ri_ML_dflt ! The default bulk Richardson number for a bulk mixed layer [nondim] real :: Kv_background ! The background kinematic viscosity in the interior [m2 s-1] @@ -1989,7 +1989,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! isopycnal or stacked shallow water mode. logical :: use_temperature ! If true, temperature and salinity are used as state variables. logical :: use_EOS ! If true, density calculated from T & S using an equation of state. - character(len=200) :: filename, tideamp_file + character(len=200) :: filename, tideamp_file ! Input file names or paths + character(len=80) :: tideamp_var ! Input file variable names ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. @@ -2090,7 +2091,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then - call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") + call MOM_error(WARNING, "ML_USE_OMEGA is deprecated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & @@ -2130,6 +2131,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") else call get_param(param_file, mdl, "DRAG_BG_VEL", CS%drag_bg_vel, & "DRAG_BG_VEL is either the assumed bottom velocity (with "//& @@ -2223,7 +2227,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then - ! This is necessary for reproduciblity across restarts in non-symmetric mode. + ! This is necessary for reproducibility across restarts in non-symmetric mode. call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.) endif @@ -2257,7 +2261,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS allocate(CS%tideamp(isd:ied,jsd:jed), source=0.0) filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) + call MOM_read_data(filename, tideamp_var, CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) call pass_var(CS%tideamp,G%domain) endif endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 645a6ef491..1528a644ec 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -48,7 +48,7 @@ module MOM_tidal_mixing real, allocatable :: Kd_Niku_work(:,:,:) !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] - real, allocatable :: N2_int(:,:,:) !< Bouyancy frequency squared at interfaces [T-2 ~> s-2] + real, allocatable :: N2_int(:,:,:) !< Buoyancy frequency squared at interfaces [T-2 ~> s-2] real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition [W m-3] real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme, in UNITS? real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, @@ -61,7 +61,7 @@ module MOM_tidal_mixing real, allocatable :: N2_bot(:,:) !< bottom squared buoyancy frequency [T-2 ~> s-2] real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2] real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m] - real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal diss with Polzin [Z ~> m] + real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal dissipation with Polzin [Z ~> m] real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient end type @@ -154,7 +154,7 @@ module MOM_tidal_mixing real, allocatable :: TKE_Niku(:,:) !< Lee wave driven Turbulent Kinetic Energy input !! [R Z3 T-3 ~> W m-2] real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. + !! by the bottom stratification [R Z3 T-2 ~> J m-2]. real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1]. real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2]. @@ -236,8 +236,9 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di ! forms of the same expressions. character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type - character(len=200) :: filename, h2_file, Niku_TKE_input_file - character(len=200) :: tidal_energy_file, tideamp_file + character(len=200) :: filename, h2_file, Niku_TKE_input_file ! Input file names + character(len=200) :: tideamp_file ! Input file names or paths + character(len=80) :: tideamp_var, rough_var, TKE_input_var ! Input file variable names real :: utide, hamp, prandtl_tidal, max_frac_rough real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je @@ -496,7 +497,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") + call MOM_read_data(filename, tideamp_var, CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -505,7 +509,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & + "The name in the input file of the squared sub-grid-scale "//& + "topographic roughness amplitude variable.", default="h2") + call MOM_read_data(filename, rough_var, CS%h2, G%domain, scale=US%m_to_Z**2) call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& @@ -546,10 +553,13 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di units="nondim", default=1.0) filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) - call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & - filename) + call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", filename) + call get_param(param_file, mdl, "TKE_INPUT_VAR", TKE_input_var, & + "The name in the input file of the turbulent kinetic energy input variable.", & + default="TKE_input") allocate(CS%TKE_Niku(is:ie,js:je), source=0.) - call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja + + call MOM_read_data(filename, TKE_input_var, CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja scale=Niku_scale*US%W_m2_to_RZ3_T3) call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & @@ -557,8 +567,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di "locally with LEE_WAVE_DISSIPATION.", units="nondim", & default=0.3333) call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & - "Scaling for the vertical decay scaleof the local "//& - "dissipation of lee waves dissipation.", units="nondim", & + "Scaling for the vertical decay scale of the local "//& + "dissipation of lee wave dissipation.", units="nondim", & default=1.0) else CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False @@ -576,10 +586,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di "Min allowable depth for dissipation for tidal-energy-constituent data. "//& "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & units="m", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & - "The path to the file containing tidal energy "//& - "dissipation. Used with CVMix tidal mixing schemes.", & - fail_if_missing=.true.) call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & @@ -589,7 +595,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di do_not_log=.true.) call CVMix_put(CS%CVMix_glb_params,'Prandtl',prandtl_tidal) - tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & "The type of input tidal energy flux dataset. Valid values are"//& "\t Jayne\n"//& @@ -614,7 +619,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides*US%Z_to_m) - call read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) + call read_tidal_energy(G, US, tidal_energy_type, param_file, CS) !call closeParameterBlock(param_file) @@ -1572,29 +1577,41 @@ end subroutine tidal_mixing_h_amp ! TODO: move this subroutine to MOM_internal_tide_input module (?) !> This subroutine read tidal energy inputs from a file. -subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) +subroutine read_tidal_energy(G, US, tidal_energy_type, param_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read - character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module - ! local + + ! local variables + character(len=200) :: tidal_energy_file ! Input file names or paths + character(len=200) :: tidal_input_var ! Input file variable name + character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. integer :: i, j, isd, ied, jsd, jed real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + call get_param(param_file, mdl, "TIDAL_ENERGY_FILE", tidal_energy_file, & + "The path to the file containing tidal energy dissipation. "//& + "Used with CVMix tidal mixing schemes.", fail_if_missing=.true.) + tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) + select case (uppercase(tidal_energy_type(1:4))) case ('JAYN') ! Jayne 2009 if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) - call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) + call get_param(param_file, mdl, "TIDAL_DISSIPATION_VAR", tidal_input_var, & + "The name in the input file of the tidal energy source for mixing.", & + default="wave_dissipation") + call MOM_read_data(tidal_energy_file, tidal_input_var, tidal_energy_flux_2d, G%domain) do j=G%jsc,G%jec ; do i=G%isc,G%iec CS%tidal_qe_2d(i,j) = CS%Gamma_itides * tidal_energy_flux_2d(i,j) enddo ; enddo deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 - call read_tidal_constituents(G, US, tidal_energy_file, CS) + call read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") end select @@ -1602,10 +1619,11 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) end subroutine read_tidal_energy !> This subroutine reads tidal input energy from a file by constituent. -subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) +subroutine read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidal energy inputs + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local variables From 530cd58a33e48aa0235635aff8ad21bd12979436 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 14 Nov 2022 10:04:40 -0500 Subject: [PATCH 022/213] +Set more input file variable names at runtime Added calls to get_param to set 4 more input variable names in files via runtime, including U_IC_VAR, V_IC_VAR, OPEN_DY_CU_VAR and OPEN_DX_CV_VAR. Also added or amended comments describing internal variables to describe their units more consistently in MOM_shared_initialization. All answers are bitwise identical, but there may be new entries in some MOM_parameter_doc files. --- .../MOM_shared_initialization.F90 | 59 +++++++++++-------- .../MOM_state_initialization.F90 | 18 ++++-- 2 files changed, 48 insertions(+), 29 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index ff272e7fce..53bfe851b0 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -96,7 +96,7 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j - real :: f1, f2 + real :: f1, f2 ! Average of adjacent Coriolis parameters [T-1 ~> s-1] if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then @@ -121,8 +121,8 @@ end subroutine MOM_calculate_grad_Coriolis function diagnoseMaximumDepth(D, G) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: D !< Ocean bottom depth in m or Z - real :: diagnoseMaximumDepth !< The global maximum ocean bottom depth in m or Z + intent(in) :: D !< Ocean bottom depth in [m] or [Z ~> m] + real :: diagnoseMaximumDepth !< The global maximum ocean bottom depth in [m] or [Z ~> m] ! Local variables integer :: i,j diagnoseMaximumDepth = D(G%isc,G%jsc) @@ -292,7 +292,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! Local variables real :: min_depth ! The minimum depth [Z ~> m]. - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] real :: expdecay ! A decay scale of associated with the sloping boundaries [L ~> m] real :: Dedge ! The depth at the basin edge [Z ~> m] @@ -449,7 +449,7 @@ subroutine set_rotation_planetary(f, G, param_file, US) ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] real :: omega ! The planetary rotation rate [T-1 ~> s-1] call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -480,10 +480,10 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) integer :: I, J real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] real :: beta ! The meridional gradient of the Coriolis parameter [T-1 L-1 ~> s-1 m-1] - real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] + real :: beta_lat_ref ! The reference latitude for the beta plane [degrees_N] or [km] or [m] real :: Rad_Earth_L ! The radius of the planet in rescaled units [L ~> m] real :: y_scl ! A scaling factor from the units of latitude [L lat-1 ~> m lat-1] - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units character(len=40) :: beta_lat_ref_units @@ -533,10 +533,12 @@ subroutine initialize_grid_rotation_angle(G, PF) type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. - real :: angle, lon_scale - real :: len_lon ! The periodic range of longitudes, usually 360 degrees. - real :: pi_720deg ! One quarter the conversion factor from degrees to radians. - real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + real :: angle ! The clockwise angle of the grid relative to true north [degrees] + real :: lon_scale ! The trigonometric scaling factor converting changes in longitude + ! to equivalent distances in latitudes [nondim] + real :: len_lon ! The periodic range of longitudes, usually 360 degrees [degrees_E]. + real :: pi_720deg ! One quarter the conversion factor from degrees to radians [radian degree-1] + real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value [degrees_E]. character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. logical :: use_bugs integer :: i, j, m, n @@ -587,10 +589,10 @@ end subroutine initialize_grid_rotation_angle !> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)] !! If Lx<=0, then it returns x without applying modulo arithmetic. function modulo_around_point(x, xc, Lx) result(x_mod) - real, intent(in) :: x !< Value to which to apply modulo arithmetic - real, intent(in) :: xc !< Center of modulo range - real, intent(in) :: Lx !< Modulo range width - real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc. + real, intent(in) :: x !< Value to which to apply modulo arithmetic [A] + real, intent(in) :: xc !< Center of modulo range [A] + real, intent(in) :: Lx !< Modulo range width [A] + real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc [A]. if (Lx > 0.0) then x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx) @@ -611,9 +613,9 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. - real :: dx_2 ! Half the local zonal grid spacing [degreesE] - real :: dy_2 ! Half the local meridional grid spacing [degreesN] - real :: pi_180 + real :: dx_2 ! Half the local zonal grid spacing [degrees_E] + real :: dy_2 ! Half the local meridional grid spacing [degrees_N] + real :: pi_180 ! Conversion factor from degrees to radians [nondim] integer :: option integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -738,7 +740,9 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path + character(len=64) :: dxCv_open_var, dyCu_open_var ! Open face length names in files integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. @@ -758,7 +762,14 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) + call get_param(param_file, mdl, "OPEN_DY_CU_VAR", dyCu_open_var, & + "The u-face open face length variable in CHANNEL_WIDTH_FILE.", & + default="dyCuo") + call get_param(param_file, mdl, "OPEN_DX_CV_VAR", dxCv_open_var, & + "The v-face open face length variable in CHANNEL_WIDTH_FILE.", & + default="dxCvo") + + call MOM_read_vector(filename, dyCu_open_var, dxCv_open_var, G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB @@ -806,7 +817,7 @@ subroutine reset_face_lengths_list(G, param_file, US) character(len=200) :: filename, chan_file, inputdir ! Strings for file/path character(len=40) :: mdl = "reset_face_lengths_list" ! This subroutine's name. real, allocatable, dimension(:,:) :: & - u_lat, u_lon, v_lat, v_lon ! The latitude and longitude ranges of faces [degrees] + u_lat, u_lon, v_lat, v_lon ! The latitude and longitude ranges of faces [degrees_N] or [degrees_E] real, allocatable, dimension(:) :: & u_width, v_width ! The open width of faces [m] integer, allocatable, dimension(:) :: & @@ -816,10 +827,10 @@ subroutine reset_face_lengths_list(G, param_file, US) Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] real, allocatable, dimension(:) :: & Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [m] - real :: lat, lon ! The latitude and longitude of a point. - real :: len_lon ! The periodic range of longitudes, usually 360 degrees. - real :: len_lat ! The range of latitudes, usually 180 degrees. - real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees. + real :: lat, lon ! The latitude and longitude of a point [degrees_N] and [degrees_E]. + real :: len_lon ! The periodic range of longitudes, usually 360 degrees [degrees_E]. + real :: len_lat ! The range of latitudes, usually 180 degrees [degrees_N]. + real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees [degrees_E]. logical :: check_360 ! If true, check for longitudes that are shifted by ! +/- 360 degrees from the specified range of values. logical :: found_u, found_v diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0cd94d1e79..0f8beb4927 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1473,7 +1473,8 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read) !! parameters without changing u or v. ! Local variables character(len=40) :: mdl = "initialize_velocity_from_file" ! This subroutine's name. - character(len=200) :: filename,velocity_file,inputdir ! Strings for file/path + character(len=200) :: filename, velocity_file, inputdir ! Strings for file/path + character(len=64) :: u_IC_var, v_IC_var ! Velocity component names in files if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -1483,16 +1484,23 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - if (just_read) return ! All run-time parameters have been read, so return. - filename = trim(inputdir)//trim(velocity_file) - call log_param(param_file, mdl, "INPUTDIR/VELOCITY_FILE", filename) + if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/VELOCITY_FILE", filename) + + call get_param(param_file, mdl, "U_IC_VAR", u_IC_var, & + "The initial condition variable for zonal velocity in VELOCITY_FILE.", & + default="u") + call get_param(param_file, mdl, "V_IC_VAR", v_IC_var, & + "The initial condition variable for meridional velocity in VELOCITY_FILE.", & + default="v") + + if (just_read) return ! All run-time parameters have been read, so return. if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_velocity_from_file: Unable to open "//trim(filename)) ! Read the velocities from a netcdf file. - call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) + call MOM_read_vector(filename, u_IC_var, v_IC_var, u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file From 08c9aa1a9e744786165615ea8de34748cd4411da Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 Nov 2022 05:46:45 -0500 Subject: [PATCH 023/213] *Fix bug with TIDAL_ENERGY_TYPE = "ER03" Corrected a bug in converting depths read from an input file from units of cm to m when the ER03 version of tidal mixing is used. This commit will change answers when INT_TIDE_DISSIPATION = True, USE_CVMix_TIDAL = True, and TIDAL_ENERGY_TYPE = "ER03". There are no such configurations in the MOM6-examples pipeline tests, and it is not clear whether or where such a configuration has ever been used. This bug was introduced into dev/gfdl on Nov. 19, 2018 as a part of PR #883 in commit https://github.com/NOAA-GFDL/MOM6/commit/967e470, which was supposed to be a refactoring of this portion of the code without changing answers, but introduced this bug. This commit should restore solutions with impacted configurations to what they would have been before that earlier commit. --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 1528a644ec..75798ed466 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1665,8 +1665,8 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain) ! Note the hard-coded assumption that z_t and z_w in the file are in centimeters. - call MOM_read_data(tidal_energy_file, 'z_t', z_t, scale=100.0*US%m_to_Z) - call MOM_read_data(tidal_energy_file, 'z_w', z_w, scale=100.0*US%m_to_Z) + call MOM_read_data(tidal_energy_file, 'z_t', z_t, scale=0.01*US%m_to_Z) + call MOM_read_data(tidal_energy_file, 'z_w', z_w, scale=0.01*US%m_to_Z) do j=js,je ; do i=is,ie if (abs(G%geoLatT(i,j)) < 30.0) then From 2ef7ba1c51cf1f3d3b7424dbd2eff94a693808b6 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 17 Nov 2022 17:45:21 -0500 Subject: [PATCH 024/213] .testing: Use Fortran to generate tc inputs This patch removes the `build_{grid,data}.py` scripts from .testing's tc4, along with the setup of the Python infrastructure used in the .testing Makefile and GitHub Actions CI. The Python scripts have been replaced with equivalent Fortran programs which generate identical netCDF output. A new rule (`preproc`) has been added to the .testing top Makefile for generating the model input files. The netCDF compiler dependenices are configured with autoconf, currently duplicating the macros in `ac/configure.ac`. (NOTE: It may be possible to share these with a common macro in ac/m4. The configure script and Makefile are currently generated from `configure.ac` and `autoreconf`. In the future, we could simply pre-generate `configure` and add it to the repository. This patch was motivated by the inability to install recent netCDF-Python packages on systems with older gcc compilers, including our main production machine. We could have possibly resolved this by adding compiler configuration to pip, or perhaps reported the issue to the netCDF-python project for them to resolve. But the costs of relying on all this Python infrastructure is starting to exceed the benefits, and I would recommend we excise it from our test suite. --- .github/actions/testing-setup/action.yml | 12 -- .github/workflows/coupled-api.yml | 1 - .testing/Makefile | 91 ++++------- .testing/tc4/.gitignore | 13 +- .testing/tc4/Makefile | 8 - .testing/tc4/Makefile.in | 38 +++++ .testing/tc4/build_data.py | 80 ---------- .testing/tc4/build_grid.py | 76 --------- .testing/tc4/configure.ac | 71 +++++++++ .testing/tc4/gen_data.F90 | 189 +++++++++++++++++++++++ .testing/tc4/gen_grid.F90 | 108 +++++++++++++ 11 files changed, 448 insertions(+), 239 deletions(-) delete mode 100644 .testing/tc4/Makefile create mode 100644 .testing/tc4/Makefile.in delete mode 100644 .testing/tc4/build_data.py delete mode 100644 .testing/tc4/build_grid.py create mode 100644 .testing/tc4/configure.ac create mode 100644 .testing/tc4/gen_data.F90 create mode 100644 .testing/tc4/gen_grid.F90 diff --git a/.github/actions/testing-setup/action.yml b/.github/actions/testing-setup/action.yml index 8a3264b140..6ba149d927 100644 --- a/.github/actions/testing-setup/action.yml +++ b/.github/actions/testing-setup/action.yml @@ -5,10 +5,6 @@ inputs: description: 'If true, will build the symmetric MOM6 executable' required: false default: 'true' - install_python: - description: 'If true, will install the local python env needed for .testing' - required: false - default: 'true' runs: using: 'composite' steps: @@ -54,14 +50,6 @@ runs: test ${{ inputs.build_symmetric }} == true && make build/symmetric/MOM6 -j echo "::endgroup::" - - name: Install local python venv for generating input data - shell: bash - run: | - echo "::group::Create local python env for input data generation" - cd .testing - test ${{ inputs.install_python }} == true && make work/local-env - echo "::endgroup::" - - name: Set flags shell: bash run: | diff --git a/.github/workflows/coupled-api.yml b/.github/workflows/coupled-api.yml index 443755c7f4..2c9fa32720 100644 --- a/.github/workflows/coupled-api.yml +++ b/.github/workflows/coupled-api.yml @@ -20,7 +20,6 @@ jobs: - uses: ./.github/actions/testing-setup with: build_symmetric: 'false' - install_python: 'false' - name: Compile MOM6 for the GFDL coupled driver shell: bash diff --git a/.testing/Makefile b/.testing/Makefile index 530a552181..3e5c174239 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -11,7 +11,7 @@ # Delete the MOM6 test executables and dependency builds (FMS) # # make clean.build -# Delete only the MOM6 test executables +# Delete only the MOM6 test executables # # # Configuration: @@ -204,34 +204,11 @@ endif FMS_SOURCE = $(call SOURCE,deps/fms/src) -#--- -# Python preprocessing environment configuration - -HAS_NUMPY = $(shell python -c "import numpy" 2> /dev/null && echo "yes") -HAS_NETCDF4 = $(shell python -c "import netCDF4" 2> /dev/null && echo "yes") - -USE_VENV = -ifneq ($(HAS_NUMPY), yes) - USE_VENV = yes -endif -ifneq ($(HAS_NETCDF4), yes) - USE_VENV = yes -endif - -# When disabled, activation is a null operation (`true`) -VENV_PATH = -VENV_ACTIVATE = true -ifeq ($(USE_VENV), yes) - VENV_PATH = work/local-env - VENV_ACTIVATE = . $(VENV_PATH)/bin/activate -endif - - #--- # Rules .PHONY: all build.regressions build.prof -all: $(foreach b,$(BUILDS),build/$(b)) $(VENV_PATH) +all: $(foreach b,$(BUILDS),build/$(b)) build.regressions: $(foreach b,symmetric target,build/$(b)/MOM6) build.prof: $(foreach b,opt opt_target,build/$(b)/MOM6) @@ -382,8 +359,8 @@ deps/Makefile: ../ac/deps/Makefile # broken the ability to compile. This is not a means to build a complete # coupled executable. # TODO: -# - Avoid re-building FMS and MOM6 src by re-using existing object/mod files -# - Use autoconf rather than mkmf templates +# - Avoid re-building FMS and MOM6 src by re-using existing object/mod files +# - Use autoconf rather than mkmf templates MK_TEMPLATE ?= ../../deps/mkmf/templates/ncrc-gnu.mk # NUOPC driver @@ -402,21 +379,6 @@ build/mct/mom_ocean_model_mct.o: build/mct/Makefile check_mom6_api_mct: build/mct/mom_ocean_model_mct.o -#--- -# Python preprocessing - -# NOTE: Some less mature environments (e.g. Arm64 Ubuntu) require explicit -# installation of numpy before netCDF4, as well as wheel and cython support. -work/local-env: - python3 -m venv $@ - . $@/bin/activate \ - && python3 -m pip install --upgrade pip \ - && pip3 install wheel \ - && pip3 install cython \ - && pip3 install numpy \ - && pip3 install netCDF4 - - #--- # Testing @@ -555,6 +517,20 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) @echo -e "$(PASS): Diagnostics $*.regression.diag agree." +#--- +# Preprocessing +# NOTE: This only support tc4, but can be generalized over all tests. +.PHONY: preproc +preproc: tc4/Makefile + cd tc4 && make + +tc4/Makefile: tc4/configure tc4/Makefile.in + cd $(@D) && ./configure || (cat config.log && false) + +tc4/configure: tc4/configure.ac + cd $(@D) && autoreconf -if + + #--- # Test run output files @@ -567,17 +543,10 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # $(6): Number of MPI ranks define STAT_RULE -work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) +work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 | preproc @echo "Running test $$*.$(1)..." mkdir -p $$(@D) cp -RL $$*/* $$(@D) - if [ -f $$(@D)/Makefile ]; then \ - $$(VENV_ACTIVATE) \ - && cd $$(@D) \ - && $(MAKE); \ - else \ - cd $$(@D); \ - fi mkdir -p $$(@D)/RESTART echo -e "$(4)" > $$(@D)/MOM_override rm -f results/$$*/std.$(1).{out,err} @@ -615,7 +584,7 @@ report.cov: run.cov codecov || { \ cat build/cov/codecov.err ; \ echo -e "${RED}Failed to upload report.${RESET}" ; \ - if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ + if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } # Define $(,) as comma escape character @@ -643,17 +612,10 @@ $(eval $(call STAT_RULE,cov,cov,true,,,1)) # 2. Convert DAYMAX from TIMEUNIT to seconds # 3. Apply seconds to `ocean_solo_nml` inside input.nml. # NOTE: Assumes that runtime set by DAYMAX, will fail if set by input.nml -work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) +work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc rm -rf $(@D) mkdir -p $(@D) cp -RL $*/* $(@D) - if [ -f $(@D)/Makefile ]; then \ - $(VENV_ACTIVATE) \ - && cd work/$*/restart \ - && $(MAKE); \ - else \ - cd work/$*/restart; \ - fi mkdir -p $(@D)/RESTART # Set the half-period cd $(@D) \ @@ -754,7 +716,7 @@ report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov || { \ cat build/unit/codecov.err ; \ echo -e "${RED}Failed to upload report.${RESET}" ; \ - if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ + if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } @@ -833,6 +795,13 @@ clean.build: .PHONY: clean.stats -clean.stats: +clean.stats: clean.preproc @[ $$(basename $$(pwd)) = .testing ] rm -rf work results + + +.PHONY: clean.preproc +clean.preproc: + @if [ -f tc4/Makefile ] ; then \ + cd tc4 && make clean ; \ + fi diff --git a/.testing/tc4/.gitignore b/.testing/tc4/.gitignore index 29f62fb208..4f9cc2826f 100644 --- a/.testing/tc4/.gitignore +++ b/.testing/tc4/.gitignore @@ -1,4 +1,15 @@ +# Autoconf +aclocal.m4 +autom4te.cache/ +config.log +config.status +configure~ + +# Output +gen_grid ocean_hgrid.nc +topog.nc + +gen_data sponge.nc temp_salt_ic.nc -topog.nc diff --git a/.testing/tc4/Makefile b/.testing/tc4/Makefile deleted file mode 100644 index a9aa395b9c..0000000000 --- a/.testing/tc4/Makefile +++ /dev/null @@ -1,8 +0,0 @@ -OUT=ocean_hgrid.nc sponge.nc temp_salt_ic.nc topog.nc - -$(OUT): - python build_grid.py - python build_data.py - -clean: - rm -rf $(OUT) diff --git a/.testing/tc4/Makefile.in b/.testing/tc4/Makefile.in new file mode 100644 index 0000000000..249d86b0b6 --- /dev/null +++ b/.testing/tc4/Makefile.in @@ -0,0 +1,38 @@ +FC = @FC@ +LD = @LD@ +FCFLAGS = @FCFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +OUT = topog.nc ocean_hgrid.nc temp_salt_ic.nc sponge.nc + +all: $(OUT) + +ocean_hgrid.nc topog.nc: gen_grid + ./gen_grid + +temp_salt_ic.nc sponge.nc: gen_data + ./gen_data + +gen_grid: gen_grid.F90 + $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) + +gen_data: gen_data.F90 + $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) + +.PHONY: clean +clean: + rm -rf $(OUT) gen_grid gen_data + +.PHONY: distclean +distclean: clean + rm -f config.log + rm -f config.status + rm -f Makefile + +.PHONY: ac-clean +ac-clean: distclean + rm -f aclocal.m4 + rm -rf autom4te.cache + rm -f configure + rm -f configure~ diff --git a/.testing/tc4/build_data.py b/.testing/tc4/build_data.py deleted file mode 100644 index e060d05cb1..0000000000 --- a/.testing/tc4/build_data.py +++ /dev/null @@ -1,80 +0,0 @@ -import netCDF4 as nc -import numpy as np - -x = nc.Dataset('ocean_hgrid.nc').variables['x'][1::2, 1::2] -y = nc.Dataset('ocean_hgrid.nc').variables['y'][1::2, 1::2] -zbot = nc.Dataset('topog.nc').variables['depth'][:] -zbot0 = zbot.max() - - -def t_fc(x, y, z, radius=5.0, tmag=1.0): - """a radially symmetric anomaly in the center of the domain. - units are meters and degC. - """ - ny, nx = x.shape - nz = z.shape[0] - - x0 = x[int(ny/2), int(nx/2)] - y0 = y[int(ny/2), int(nx/2)] - - tl = np.zeros((nz, ny, nx)) - zb = z[-1] - if len(z) > 1: - zd = z / zb - else: - zd = [0.] - for k in np.arange(len(zd)): - r = np.sqrt((x - x0)**2 + (y - y0)**2) - tl[k, :] += (1.0 - np.minimum(r / radius, 1.0)) * tmag * (1.0 - zd[k]) - return tl - - -ny, nx = x.shape -nz = 3 -z = (np.arange(nz) * zbot0) / nz - -temp = t_fc(x, y, z) -salt = np.zeros(temp.shape)+35.0 -fl = nc.Dataset('temp_salt_ic.nc', 'w', format='NETCDF3_CLASSIC') -fl.createDimension('lon', nx) -fl.createDimension('lat', ny) -fl.createDimension('depth', nz) -fl.createDimension('Time', None) -zv = fl.createVariable('depth', 'f8', ('depth')) -lonv = fl.createVariable('lon', 'f8', ('lon')) -latv = fl.createVariable('lat', 'f8', ('lat')) -timev = fl.createVariable('Time', 'f8', ('Time')) -timev.calendar = 'noleap' -timev.units = 'days since 0001-01-01 00:00:00.0' -timev.modulo = ' ' -tv = fl.createVariable('ptemp', 'f8', ('Time', 'depth', 'lat', 'lon'), - fill_value=-1.e20) -sv = fl.createVariable('salt', 'f8', ('Time', 'depth', 'lat', 'lon'), - fill_value=-1.e20) -tv[:] = temp[np.newaxis, :] -sv[:] = salt[np.newaxis, :] -zv[:] = z -lonv[:] = x[0, :] -latv[:] = y[:, 0] -timev[0] = 0. -fl.sync() -fl.close() - - -# Make Sponge forcing file -dampTime = 20.0 # days -secDays = 8.64e4 -fl = nc.Dataset('sponge.nc', 'w', format='NETCDF3_CLASSIC') -fl.createDimension('lon', nx) -fl.createDimension('lat', ny) -lonv = fl.createVariable('lon', 'f8', ('lon')) -latv = fl.createVariable('lat', 'f8', ('lat')) -spv = fl.createVariable('Idamp', 'f8', ('lat', 'lon'), fill_value=-1.e20) -Idamp = np.zeros((ny, nx)) -if dampTime > 0.: - Idamp = 0.0 + 1.0 / (dampTime * secDays) -spv[:] = Idamp -lonv[:] = x[0, :] -latv[:] = y[:, 0] -fl.sync() -fl.close() diff --git a/.testing/tc4/build_grid.py b/.testing/tc4/build_grid.py deleted file mode 100644 index 7f1be74efd..0000000000 --- a/.testing/tc4/build_grid.py +++ /dev/null @@ -1,76 +0,0 @@ -import netCDF4 as nc -from netCDF4 import stringtochar -import numpy as np - -nx, ny = 14, 10 # Grid size -depth0 = 100. # Uniform depth -ds = 0.01 # grid resolution at the equator in degrees -Re = 6.378e6 # Radius of earth - -topo_ = np.zeros((ny, nx)) + depth0 -f_topo = nc.Dataset('topog.nc', 'w', format='NETCDF3_CLASSIC') -ny, nx = topo_.shape -f_topo.createDimension('ny', ny) -f_topo.createDimension('nx', nx) -f_topo.createDimension('ntiles', 1) -f_topo.createVariable('depth', 'f8', ('ny', 'nx')) -f_topo.createVariable('h2', 'f8', ('ny', 'nx')) -f_topo.variables['depth'][:] = topo_ -f_topo.sync() -f_topo.close() - -x_ = np.arange(0, 2*nx + 1) * ds # units are degrees E -y_ = np.arange(0, 2*ny + 1) * ds # units are degrees N -x, y = np.meshgrid(x_, y_) - -dx = np.zeros((2*ny + 1, 2*nx)) -dy = np.zeros((2*ny, 2*nx + 1)) -rad_deg = np.pi / 180. -dx[:] = (rad_deg * Re * (x[:, 1:] - x[:, 0:-1]) - * np.cos(0.5*rad_deg*(y[:, 0:-1] + y[:, 1:]))) -dy[:] = rad_deg * Re * (y[1:, :] - y[0:-1, :]) - -f_sg = nc.Dataset('ocean_hgrid.nc', 'w', format='NETCDF3_CLASSIC') -f_sg.createDimension('ny', 2*ny) -f_sg.createDimension('nx', 2*nx) -f_sg.createDimension('nyp', 2*ny + 1) -f_sg.createDimension('nxp', 2*nx + 1) -f_sg.createDimension('string', 5) -f_sg.createVariable('y', 'f8', ('nyp', 'nxp')) -f_sg.createVariable('x', 'f8', ('nyp', 'nxp')) -dyv = f_sg.createVariable('dy', 'f8', ('ny', 'nxp')) -dxv = f_sg.createVariable('dx', 'f8', ('nyp', 'nx')) -areav = f_sg.createVariable('area', 'f8', ('ny', 'nx')) -dxv.units = 'm' -dyv.units = 'm' -areav.units = 'm2' -f_sg.createVariable('angle_dx', 'f8', ('nyp', 'nxp')) -f_sg.createVariable('tile', 'S1', ('string')) -f_sg.variables['y'].units = 'degrees' -f_sg.variables['x'].units = 'degrees' -f_sg.variables['dy'].units = 'meters' -f_sg.variables['dx'].units = 'meters' -f_sg.variables['area'].units = 'm2' -f_sg.variables['angle_dx'].units = 'degrees' -f_sg.variables['y'][:] = y -f_sg.variables['x'][:] = x -f_sg.variables['dx'][:] = dx -f_sg.variables['dy'][:] = dy - -# Compute the area bounded by lines of constant -# latitude-longitud on a sphere in m2. -dlon = x_[1:] - x_[:-1] -dlon = np.tile(dlon[np.newaxis, :], (2*ny, 1)) -y1_ = y_[:-1] -y1_ = y1_[:, np.newaxis]*rad_deg -y2_ = y_[1:] -y2_ = y2_[:, np.newaxis]*rad_deg -y1_ = np.tile(y1_, (1, 2*nx)) -y2_ = np.tile(y2_, (1, 2*nx)) -area = rad_deg * Re * Re * (np.sin(y2_) - np.sin(y1_)) * dlon -f_sg.variables['area'][:] = area -f_sg.variables['angle_dx'][:] = 0. -str_ = stringtochar(np.array(['tile1'], dtype='S5')) -f_sg.variables['tile'][:] = str_ -f_sg.sync() -f_sg.close() diff --git a/.testing/tc4/configure.ac b/.testing/tc4/configure.ac new file mode 100644 index 0000000000..c431ad65ef --- /dev/null +++ b/.testing/tc4/configure.ac @@ -0,0 +1,71 @@ +# tc4 preprocessor configuration +AC_PREREQ([2.63]) +AC_INIT([], []) + +# Validate srdcir and configure input +AC_CONFIG_SRCDIR([gen_grid.F90]) +AC_CONFIG_MACRO_DIR([../../ac/m4]) + + +# Explicitly assume free-form Fortran +AC_LANG([Fortran]) +AC_FC_SRCEXT([f90]) + +# We do not need MPI, but we want to emulate the executable used in MOM6 +AX_MPI([], [AC_MSG_ERROR([Could not find MPI launcher.])]) +AC_SUBST([FC], [$MPIFC]) +AC_SUBST([LD], [$MPILD]) + + +# netCDF configuration + +# Search for the Fortran netCDF module. +AX_FC_CHECK_MODULE([netcdf], [], [ + AS_UNSET([ax_fc_cv_mod_netcdf]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([FCFLAGS], ["$FCFLAGS -I$($NF_CONFIG --includedir)"]) + ], [AC_MSG_ERROR([Could not find nf-config.])] + ) + AX_FC_CHECK_MODULE([netcdf], [], [ + AC_MSG_ERROR([Could not find netcdf module.]) + ]) +]) + +# Confirm that the Fortran compiler can link the netCDF C library +AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AS_UNSET([ax_fc_cv_c_lib_netcdf_nc_create]) + AC_PATH_PROG([NC_CONFIG], [nc-config]) + AS_IF([test -n "$NC_CONFIG"], [ + AC_SUBST([LDFLAGS], ["$LDFLAGS -L$($NC_CONFIG --libdir)"]) + ], [ + AC_MSG_ERROR([Could not find nc-config.]) + ]) + AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AC_MSG_ERROR([Could not find netCDF C library.]) + ]) +]) + +# Confirm that the Fortran compiler can link to the netCDF Fortran library. +# NOTE: +# - We test nf_create, rather than nf90_create, since AX_FC_CHECK_LIB can +# not currently probe the Fortran 90 interfaces. +# - nf-config does not have --libdir, so we parse the --flibs output. +AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ + AS_UNSET([ax_fc_cv_lib_netcdff_nf_create]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([LDFLAGS], + ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] + ) + ], [ + AC_MSG_ERROR([Could not find nf-config.]) + ]) + AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ + AC_MSG_ERROR([Could not find netCDF Fortran library.]) + ]) +]) + + +AC_CONFIG_FILES([Makefile]) +AC_OUTPUT diff --git a/.testing/tc4/gen_data.F90 b/.testing/tc4/gen_data.F90 new file mode 100644 index 0000000000..8f44aa1465 --- /dev/null +++ b/.testing/tc4/gen_data.F90 @@ -0,0 +1,189 @@ +use netcdf +implicit none + +integer, parameter :: dp = selected_real_kind(10, 100) + !! Double precision (8-byte) + +integer, parameter :: nz = 3 + !! Number of vertical layers +real(kind=dp), parameter :: salt0 = 35._dp + !! Background salinity +real(kind=dp), parameter :: dampTime = 20._dp + !! Sponge damping timescale [days] +real(kind=dp), parameter :: secs_per_day = 86400._dp + !! Seconds per calendar day + +integer :: ncid + +integer :: x_id, y_id +integer :: lon_dimid, lat_dimid, depth_dimid, time_dimid +integer :: lon_id, lat_id, depth_id, time_id, temp_id, salt_id, idamp_id +integer :: field_dimids(2) +integer :: nx, ny + +integer :: i, rc + +real(kind=dp), allocatable :: x(:,:), y(:,:), z(:) + !! Temperature grid positions +real(kind=dp), allocatable :: zbot(:,:) + !! Bottom topography +real(kind=dp) :: zbot0 + !! Maximum topographic depth +real(kind=dp), allocatable :: temp(:,:,:), salt(:,:,:) + !! Initial temperature and salinity fields +real(kind=dp), allocatable :: Idamp(:,:) + !! Sponge dampening rate + +! Read the domain grid +rc = nf90_open('ocean_hgrid.nc', NF90_NOWRITE, ncid) + +rc = nf90_inq_varid(ncid, 'x', x_id) +rc = nf90_inq_varid(ncid, 'y', y_id) + +rc = nf90_inquire_variable(ncid, x_id, dimids=field_dimids) +rc = nf90_inquire_dimension(ncid, field_dimids(1), len=nx) +rc = nf90_inquire_dimension(ncid, field_dimids(2), len=ny) + +! Extract center ("T") points of supergrid +nx = nx / 2 +ny = ny / 2 +allocate(x(nx, ny), y(nx, ny)) +rc = nf90_get_var(ncid, x_id, x, start=[2,2], stride=[2,2]) +rc = nf90_get_var(ncid, y_id, y, start=[2,2], stride=[2,2]) + +rc = nf90_close(ncid) + + +! Read the topographic domain +rc = nf90_open('topog.nc', NF90_NOWRITE, ncid) + +rc = nf90_inq_varid(ncid, 'depth', depth_id) +rc = nf90_inquire_variable(ncid, depth_id, dimids=field_dimids) +rc = nf90_inquire_dimension(ncid, field_dimids(1), len=nx) +rc = nf90_inquire_dimension(ncid, field_dimids(2), len=ny) + +allocate(zbot(nx, ny)) +rc = nf90_get_var(ncid, depth_id, zbot) +rc = nf90_close(ncid) + + +! Construct the vertical axis +allocate(z(nz)) +z = [(i, i=0,nz-1)] * maxval(zbot) / nz + +allocate(temp(nx, ny, nz), salt(nx, ny, nz)) +call t_fc(x, y, z, temp) +salt(:,:,:) = salt0 + + +! Write T/S initial state +rc = nf90_create('temp_salt_ic.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'lon', nx, lon_dimid) +rc = nf90_def_dim(ncid, 'lat', ny, lat_dimid) +rc = nf90_def_dim(ncid, 'depth', nz, depth_dimid) +rc = nf90_def_dim(ncid, 'Time', NF90_UNLIMITED, time_dimid) + +rc = nf90_def_var(ncid, 'depth', NF90_DOUBLE, [depth_dimid], depth_id) +rc = nf90_def_var(ncid, 'lon', NF90_DOUBLE, [lon_dimid], lon_id) +rc = nf90_def_var(ncid, 'lat', NF90_DOUBLE, [lat_dimid], lat_id) +rc = nf90_def_var(ncid, 'Time', NF90_DOUBLE, [time_dimid], time_id) + +rc = nf90_put_att(ncid, time_id, 'calendar', 'noleap') +rc = nf90_put_att(ncid, time_id, 'units', 'days since 0001-01-01 00:00:00.0') +! NOTE: nf90_put_att() truncates empty strings, so use nf90_put_att_any() +rc = nf90_put_att_any(ncid, time_id, 'modulo', NF90_CHAR, 1, ' ') + +rc = nf90_def_var(ncid, 'ptemp', NF90_DOUBLE, & + [lon_dimid, lat_dimid, depth_dimid, time_dimid], temp_id) +rc = nf90_def_var_fill(ncid, temp_id, 0, -1e20_dp) + +rc = nf90_def_var(ncid, 'salt', NF90_DOUBLE, & + [lon_dimid, lat_dimid, depth_dimid, time_dimid], salt_id) +rc = nf90_def_var_fill(ncid, salt_id, 0, -1e20_dp) + +rc = nf90_enddef(ncid) + +rc = nf90_put_var(ncid, lon_id, x(:,1)) +rc = nf90_put_var(ncid, lat_id, y(1,:)) +rc = nf90_put_var(ncid, depth_id, z) +rc = nf90_put_var(ncid, time_id, 0.) +rc = nf90_put_var(ncid, temp_id, temp) +rc = nf90_put_var(ncid, salt_id, salt) + +rc = nf90_close(ncid) + + +! Sponge file +rc = nf90_create('sponge.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'lon', nx, lon_dimid) +rc = nf90_def_dim(ncid, 'lat', ny, lat_dimid) + +rc = nf90_def_var(ncid, 'lon', NF90_DOUBLE, lon_id) +rc = nf90_def_var(ncid, 'lat', NF90_DOUBLE, lat_id) +rc = nf90_def_var(ncid, 'Idamp', NF90_DOUBLE, [lon_dimid, lat_dimid], Idamp_id) +rc = nf90_def_var_fill(ncid, Idamp_id, 0, -1e20_dp) + +rc = nf90_enddef(ncid) + +allocate(Idamp(nx, ny)) +Idamp = 0. +if (dampTime > 0.) & + Idamp(:,:) = 1. / (dampTime * secs_per_day) + +rc = nf90_put_var(ncid, Idamp_id, Idamp) +rc = nf90_put_var(ncid, lon_id, x(:,1)) +rc = nf90_put_var(ncid, lat_id, y(1,:)) + +rc = nf90_close(ncid) + +contains + +subroutine t_fc(x, y, z, tl, radius, tmag) + real(kind=dp), intent(in) :: x(:,:), y(:,:), z(:) + !! Grid positions + real(kind=dp), intent(inout) :: tl(:,:,:) + !! Temperature field on the model grid + real(kind=dp), intent(in), optional :: radius + !! Temperature anomaly radius + real(kind=dp), intent(in), optional :: tmag + !! Temperature anomaly maximum + + real(kind=dp) :: t_rad, t_max + !! Temperature field parameters (radius, max value) + real(kind=dp) :: x0, y0 + !! Center of anomaly (currently midpoint of domain) + real(kind=dp), allocatable :: r(:,:), zd(:) + !! Radial and vertical extent of anomaly + integer :: k, nz + !! Vertical level indexing + + t_rad = 5._dp + if (present(radius)) t_rad = radius + + t_max = 1._dp + if (present(tmag)) t_max = tmag + + ! Reduce supergrid size to T/S grid + allocate(zd, source=z) + + x0 = x(1 + size(x, 1)/2, 1 + size(x, 2)/2) + y0 = y(1 + size(y, 1)/2, 1 + size(y, 2)/2) + + tl(:,:,:) = 0. + nz = size(z) + if (nz > 1) then + zd(:) = z(:) / z(nz) + else + zd(:) = 0. + endif + + allocate(r, source=x) + r(:,:) = hypot(x(:,:) - x0, y(:,:) - y0) + do k = 1, nz + tl(:,:,k) = (1. - min(r(:,:) / t_rad, 1.)) * t_max * (1. - zd(k)) + enddo +end subroutine t_fc + +end diff --git a/.testing/tc4/gen_grid.F90 b/.testing/tc4/gen_grid.F90 new file mode 100644 index 0000000000..e76a681924 --- /dev/null +++ b/.testing/tc4/gen_grid.F90 @@ -0,0 +1,108 @@ +use netcdf + +implicit none + +integer, parameter :: dp = selected_real_kind(10, 100) + !! Double precision (8-byte) + +integer, parameter :: nx = 14, ny = 10 + !! Grid size +real(kind=dp), parameter :: depth0 = 100._dp + !! Uniform depth +real(kind=dp), parameter :: ds = 0.01_dp + !! Grid resolution at the equator in degrees +real(kind=dp), parameter :: Re = 6.378e6_dp + !! Radius of earth +real(kind=dp), parameter :: rad_per_deg = (4. * atan(1._dp)) / 180._dp + !! Degress to radians (= pi/180.) + +integer :: ncid +integer :: nx_id, ny_id, nxp_id, nyp_id, ntile_id, string_id +integer :: depth_id, h2_id +integer :: x_id, y_id, dx_id, dy_id, area_id, angle_id, tile_id + +! Fields on model grid +real(kind=dp) :: depth(nx, ny) + +! Grid fields (defined on supergrid) +real(kind=dp) :: xg(0:2*nx), yg(0:2*ny) +real(kind=dp) :: x(0:2*nx, 0:2*ny), y(0:2*nx, 0:2*ny) +real(kind=dp) :: dx(0:2*nx-1, 0:2*ny) +real(kind=dp) :: dy(0:2*nx, 0:2*ny-1) +real(kind=dp) :: area(0:2*nx-1, 0:2*ny-1) +real(kind=dp) :: angle_dx(0:2*nx, 0:2*ny) + +integer :: i, j, rc + + +! Topography +rc = nf90_create('topog.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'ny', ny, ny_id) +rc = nf90_def_dim(ncid, 'nx', nx, nx_id) +rc = nf90_def_dim(ncid, 'ntiles', 1, ntile_id) + +rc = nf90_def_var(ncid, 'depth', NF90_DOUBLE, [nx_id, ny_id], depth_id) +rc = nf90_def_var(ncid, 'h2', NF90_DOUBLE, [nx_id, ny_id], h2_id) + +rc = nf90_enddef(ncid) + +depth(:,:) = depth0 +rc = nf90_put_var(ncid, depth_id, depth) + +rc = nf90_close(ncid) + + +! Horizontal grid +rc = nf90_create('ocean_hgrid.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'ny', 2*ny, ny_id) +rc = nf90_def_dim(ncid, 'nx', 2*nx, nx_id) +rc = nf90_def_dim(ncid, 'nyp', 2*ny+1, nyp_id) +rc = nf90_def_dim(ncid, 'nxp', 2*nx+1, nxp_id) +rc = nf90_def_dim(ncid, 'string', 5, string_id) + +rc = nf90_def_var(ncid, 'y', NF90_DOUBLE, [nxp_id, nyp_id], y_id) +rc = nf90_def_var(ncid, 'x', NF90_DOUBLE, [nxp_id, nyp_id], x_id) +rc = nf90_def_var(ncid, 'dy', NF90_DOUBLE, [nxp_id, ny_id], dy_id) +rc = nf90_def_var(ncid, 'dx', NF90_DOUBLE, [nx_id, nyp_id], dx_id) +rc = nf90_def_var(ncid, 'area', NF90_DOUBLE, [nx_id, ny_id], area_id) +rc = nf90_def_var(ncid, 'angle_dx', NF90_DOUBLE, [nxp_id, nyp_id], angle_id) +rc = nf90_def_var(ncid, 'tile', NF90_CHAR, string_id, tile_id) + +rc = nf90_put_att(ncid, y_id, 'units', 'degrees') +rc = nf90_put_att(ncid, x_id, 'units', 'degrees') +rc = nf90_put_att(ncid, dy_id, 'units', 'meters') +rc = nf90_put_att(ncid, dx_id, 'units', 'meters') +rc = nf90_put_att(ncid, area_id, 'units', 'm2') +rc = nf90_put_att(ncid, angle_id, 'units', 'degrees') + +rc = nf90_enddef(ncid) + +xg = ds * [(i, i=0, 2*nx)] +yg = ds * [(j, j=0, 2*ny)] + +! NOTE: sin() and cos() are compiler-dependent + +x(:,:) = spread(xg(:), 2, 2*ny+1) +y(:,:) = spread(yg(:), 1, 2*nx+1) +dx(:,:) = rad_per_deg * Re * (x(1:,:) - x(:2*nx-1,:)) & + * cos(0.5 * rad_per_deg * (y(1:,:) + y(:2*nx-1,:))) +dy(:,:) = rad_per_deg * Re * (y(:,1:) - y(:,:2*ny-1)) + +area(:,:) = rad_per_deg * Re * Re & + * spread(sin(rad_per_deg * yg(1:)) - sin(rad_per_deg * yg(:2*ny-1)), 1, 2*nx) & + * spread(xg(1:) - xg(:2*nx-1), 2, 2*ny) + +angle_dx(:,:) = 0. + +rc = nf90_put_var(ncid, x_id, x) +rc = nf90_put_var(ncid, y_id, y) +rc = nf90_put_var(ncid, dx_id, dx) +rc = nf90_put_var(ncid, dy_id, dy) +rc = nf90_put_var(ncid, area_id, area) +rc = nf90_put_var(ncid, angle_id, angle_dx) +rc = nf90_put_var(ncid, tile_id, 'tile1') + +rc = nf90_close(ncid) +end From 56cf1252a8d868a561326cbba8cc44cc613dbf77 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 21 Nov 2022 14:39:41 -0500 Subject: [PATCH 025/213] Remove Python venv setup from GitLab-CI rules GitLab CI includes the internal testing suite (.testing) and included an explicit setup of the Python environment (`make work/local-env`). The rule has since been removed, and the command now fails. This patch removes those steps, since we no longer use Python in the tests. It also slightly reworks the reporting of test output. Instead of re-running `make test`, it uses the `make test.summary` rule to report the final result. --- .gitlab-ci.yml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6a622f55cc..fbc2854b33 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -26,7 +26,7 @@ p:merge: # Setup the persistent JOB_DIR for all subsequent stages # -# This basically setups up a complete tree much as a user would in their workflow +# This basically setups up a complete tree much as a user would in their workflow p:clone: stage: setup tags: @@ -181,11 +181,11 @@ actions:gnu: - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling executables" - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan ; module load PrgEnv-gnu ; module unload netcdf gcc ; module load gcc/7.3.0 cray-hdf5 cray-netcdf - - make work/local-env - make -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || ( cat log.$CI_JOB_ID ; exit 911 ) + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) + - make test.summary actions:intel: stage: tests @@ -200,11 +200,11 @@ actions:intel: - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling executables" - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan; module load PrgEnv-intel; module unload netcdf intel; module load intel/18.0.6.288 cray-hdf5 cray-netcdf - - make work/local-env - make -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh && make test || ( cat log.$CI_JOB_ID ; exit 911 ) + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) + - make test.summary # Tests # From b918b2ad5907a866ec27ea7888db606b1ff79774 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Oct 2022 12:17:27 -0400 Subject: [PATCH 026/213] +Add mask_edges argument to interpolate_column Added a new logical argument to interpolate_column to specify whether the interpolated interface values outside of massless layers should be masked to zero. Also refactored the code in interpolate_column to separate out the determination of the interface position from the interpolation and the masking to facilitate the extension of this code to use higher order interpolation in planned subsequent changes. All answers are bitwise identical, although there is a new mandatory argument for a public interface. --- src/ALE/MOM_ALE.F90 | 2 +- src/ALE/MOM_remapping.F90 | 86 +++++++++++++++----------------- src/framework/MOM_diag_remap.F90 | 6 +-- 3 files changed, 44 insertions(+), 50 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index ec71e15bbd..9f8b2336f9 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -554,7 +554,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) if (check_column_integrals(nk, h_src, nk, h_dest)) then call MOM_error(FATAL, "ALE_offline_inputs: Kd interpolation columns do not match") endif - call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), Kd(i,j,:)) + call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), Kd(i,j,:), .true.) endif enddo ; enddo diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index bfd74b435c..e9d9a53612 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -840,78 +840,72 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth end subroutine remap_via_sub_cells !> Linearly interpolate interface data, u_src, from grid h_src to a grid h_dest -subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest) +subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest, mask_edges) integer, intent(in) :: nsrc !< Number of source cells real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces [A] integer, intent(in) :: ndest !< Number of destination cells real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces [A] + logical, intent(in) :: mask_edges !< If true, mask the values outside of massless + !! layers at the top and bottom of the column. ! Local variables - real :: x_dest ! Relative position of target interface [H] - real :: dh ! Source cell thickness [H] - real :: u1, u2 ! Values to interpolate between [A] - real :: weight_a, weight_b ! Weights for interpolation [nondim] - integer :: k_src, k_dest ! Index of cell in src and dest columns - logical :: still_vanished ! Used for figuring out what to mask as missing - - ! Initial values for the loop - still_vanished = .true. + real :: x_dest ! Relative position of target interface [H] + real :: dh ! Source cell thickness [H] + real :: frac_pos(ndest+1) ! Fractional position of the destination interface + ! within the source layer [nondim], 0 <= frac_pos <= 1. + integer :: k_src(ndest+1) ! Source grid layer index of destination interface, 1 <= k_src <= ndest. + integer :: ks, k_dest ! Index of cell in src and dest columns ! The following forces the "do while" loop to do one cycle that will set u1, u2, dh. - k_src = 0 + ks = 0 dh = 0. x_dest = 0. - do k_dest=1, ndest+1 - do while (dh<=x_dest .and. k_src0.) then - weight_b = max(0., min(1., x_dest / dh)) ! Weight of u2 + frac_pos(k_dest) = max(0., min(1., x_dest / dh)) ! Weight of u2 else ! For a vanished source layer we need to do something reasonable... - weight_b = 0.5 + frac_pos(k_dest) = 0.5 endif - weight_a = 1.0 - weight_b ! Weight of u1 - ! Linear interpolation between u1 and u2 - u_dest(k_dest) = weight_a * u1 + weight_b * u2 - ! Mask vanished layers at the surface which would be under an ice-shelf. - ! TODO: Need to figure out what to do for an isopycnal coordinate diagnostic that could - ! also have vanished layers at the surface. - if (k_dest<=ndest) then + if (k_dest <= ndest) then x_dest = x_dest + h_dest(k_dest) ! Position of interface k_dest+1 - if (still_vanished .and. h_dest(k_dest)==0.) then - ! When the layer k_dest is vanished and all layers above are also vanished, the k_dest - ! interface value should be missing. - u_dest(k_dest) = 0.0 - else - still_vanished = .false. - endif endif + enddo + do k_dest=1,ndest+1 + ! Linear interpolation between surrounding edge values. + ks = k_src(k_dest) + u_dest(k_dest) = (1.0 - frac_pos(k_dest)) * u_src(ks) + frac_pos(k_dest) * u_src(ks+1) enddo - ! Mask vanished layers on topography - still_vanished = .true. - do k_dest=ndest, 1, -1 - if (still_vanished .and. h_dest(k_dest)==0.) then - ! When the layer k_dest is vanished and all layers below are also vanished, the k_dest+1 - ! interface value should be missing. + if (mask_edges) then + ! Mask vanished layers at the surface which would be under an ice-shelf. + ! When the layer k_dest is vanished and all layers above are also vanished, + ! the k_dest interface value should be missing. + do k_dest=1,ndest + if (h_dest(k_dest) > 0.) exit + u_dest(k_dest) = 0.0 + enddo + + ! Mask interfaces below vanished layers at the bottom + do k_dest=ndest,1,-1 + if (h_dest(k_dest) > 0.) exit u_dest(k_dest+1) = 0.0 - else - exit - endif - enddo + enddo + endif end subroutine interpolate_column @@ -1717,7 +1711,7 @@ logical function test_interp(verbose, msg, nsrc, h_src, u_src, ndest, h_dest, u_ real :: error ! Interpolate from src to dest - call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest) + call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest, .true.) test_interp = .false. do k=1,ndest+1 diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 05bd8aeed0..cd5682d2d9 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -608,7 +608,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) call interpolate_column(nz_src, h_src, field(I1,j,:), & - nz_dest, h_dest, interpolated_field(I1,j,:)) + nz_dest, h_dest, interpolated_field(I1,j,:), .true.) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then @@ -623,7 +623,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) call interpolate_column(nz_src, h_src, field(i,J1,:), & - nz_dest, h_dest, interpolated_field(i,J1,:)) + nz_dest, h_dest, interpolated_field(i,J1,:), .true.) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -636,7 +636,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = h(i,j,:) h_dest(:) = remap_cs%h(i,j,:) call interpolate_column(nz_src, h_src, field(i,j,:), & - nz_dest, h_dest, interpolated_field(i,j,:)) + nz_dest, h_dest, interpolated_field(i,j,:), .true.) enddo enddo else From 14f94821845b54fee9bc8f5c1012ac2a89f4ee32 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Oct 2022 15:56:02 -0400 Subject: [PATCH 027/213] +Add ALE_remap_interface_vals and ALE_remap_vertex_vals Added ALE_remap_interface_vals and ALE_remap_vertex_vals to handle the interpolation of variables that are at the interfaces atop tracer cells or above the corners of the tracers cells from one grid to another. Because these are not yet used (but have been tested in calls that will be added with the next commit) all answers are bitwise identical, but there are two new publicly visible routines. --- src/ALE/MOM_ALE.F90 | 93 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 89 insertions(+), 4 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 9f8b2336f9..2a9ebc09c8 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -129,6 +129,8 @@ module MOM_ALE public ALE_remap_scalar public ALE_remap_tracers public ALE_remap_velocities +public ALE_remap_interface_vals +public ALE_remap_vertex_vals public ALE_PLM_edge_values public TS_PLM_edge_values public TS_PPM_edge_values @@ -289,10 +291,10 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth, & depth_of_time_filter_deep=filter_deep_depth) call get_param(param_file, mdl, "REGRID_USE_OLD_DIRECTION", local_logical, & - "If true, the regridding ntegrates upwards from the bottom for "//& + "If true, the regridding integrates upwards from the bottom for "//& "interface positions, much as the main model does. If false "//& - "regridding integrates downward, consistant with the remapping "//& - "code.", default=.true., do_not_log=.true.) + "regridding integrates downward, consistent with the remapping code.", & + default=.true., do_not_log=.true.) call set_regrid_params(CS%regridCS, integrate_downward_for_e=.not.local_logical) call get_param(param_file, mdl, "REMAP_VEL_MASK_BBL_THICK", CS%BBL_h_vel_mask, & @@ -549,7 +551,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) endif enddo ; enddo - do j = jsc,jec ; do i=isc,iec + do j=jsc,jec ; do i=isc,iec if (G%mask2dT(i,j)>0.) then if (check_column_integrals(nk, h_src, nk, h_dest)) then call MOM_error(FATAL, "ALE_offline_inputs: Kd interpolation columns do not match") @@ -974,6 +976,89 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface, end subroutine ALE_remap_velocities +!> Interpolate to find an updated array of values at interfaces after remapping. +subroutine ALE_remap_interface_vals(CS, G, GV, h_old, h_new, int_val) + type(ALE_CS), intent(in) :: CS !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + intent(inout) :: int_val !< The interface values to interpolate [A] + + real :: val_src(GV%ke+1) ! A column of interface values on the source grid [A] + real :: val_tgt(GV%ke+1) ! A column of interface values on the target grid [A] + real :: h_src(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h_tgt(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + integer :: i, j, k, nz + + nz = GV%ke + + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (G%mask2dT(i,j)>0.) then + do k=1,nz + h_src(k) = h_old(i,j,k) + h_tgt(k) = h_new(i,j,k) + enddo + + do K=1,nz+1 + val_src(K) = int_val(i,j,K) + enddo + + call interpolate_column(nz, h_src, val_src, nz, h_tgt, val_tgt, .false.) + + do K=1,nz+1 + int_val(i,j,K) = val_tgt(K) + enddo + endif ; enddo ; enddo + +end subroutine ALE_remap_interface_vals + +!> Interpolate to find an updated array of values at vertices of tracer cells after remapping. +subroutine ALE_remap_vertex_vals(CS, G, GV, h_old, h_new, vert_val) + type(ALE_CS), intent(in) :: CS !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid + !! [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & + intent(inout) :: vert_val !< The interface values to interpolate [A] + + real :: val_src(GV%ke+1) ! A column of interface values on the source grid [A] + real :: val_tgt(GV%ke+1) ! A column of interface values on the target grid [A] + real :: h_src(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h_tgt(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + real :: I_mask_sum ! The inverse of the tracer point masks surrounding a corner [nondim] + integer :: i, j, k, nz + + nz = GV%ke + + do J=G%JscB,G%JecB ; do I=G%IscB,G%IecB + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) > 0.0 ) then + I_mask_sum = 1.0 / ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + (G%mask2dT(i+1,j) + G%mask2dT(i,j+1))) + + do k=1,nz + h_src(k) = ((G%mask2dT(i,j) * h_old(i,j,k) + G%mask2dT(i+1,j+1) * h_old(i+1,j+1,k)) + & + (G%mask2dT(i+1,j) * h_old(i+1,j,k) + G%mask2dT(i,j+1) * h_old(i,j+1,k)) ) * I_mask_sum + h_tgt(k) = ((G%mask2dT(i,j) * h_new(i,j,k) + G%mask2dT(i+1,j+1) * h_new(i+1,j+1,k)) + & + (G%mask2dT(i+1,j) * h_new(i+1,j,k) + G%mask2dT(i,j+1) * h_new(i,j+1,k)) ) * I_mask_sum + enddo + + do K=1,nz+1 + val_src(K) = vert_val(I,J,K) + enddo + + call interpolate_column(nz, h_src, val_src, nz, h_tgt, val_tgt, .false.) + + do K=1,nz+1 + vert_val(I,J,K) = val_tgt(K) + enddo + endif ; enddo ; enddo + +end subroutine ALE_remap_vertex_vals !> Mask out thicknesses to 0 when their running sum exceeds a specified value. subroutine apply_partial_cell_mask(h1, h_mask) From aa44c32efe15b19c01caeafd73cf9800a11e1169 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 18 Nov 2022 05:51:14 -0500 Subject: [PATCH 028/213] +Add REMAP_AUXILIARY_VARS to remap accelerations Added REMAP_AUXILIARY_VARS to control whether to remap the accelerations that are used in the predictor step of the split RK2 time stepping scheme. Also added the new routines remap_dyn_split_rk2_aux_vars, remap_OBC_fields and remap_vertvisc_aux_vars to do the remapping, and code to call these routines when REMAP_AUXILIARY_VARS is true. By default, REMAP_AUXILIARY_VARS is false, and all answers are bitwise identical, but the entire MOM6-examples regression suite has been run with this set to true, and they do appear to give physically plausible answers in all cases, partially addressing the issue noted at github.com/NOAA-GFDL/MOM6/issues/203. New entries are added to the MOM_parameter_doc files, and there are three new publicly visible routines, but by default answers do not change. --- src/core/MOM.F90 | 31 ++- src/core/MOM_dynamics_split_RK2.F90 | 39 +++- src/core/MOM_open_boundary.F90 | 179 ++++++++++++++++++ .../vertical/MOM_set_viscosity.F90 | 72 +++++-- 4 files changed, 293 insertions(+), 28 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fef71ab4d5..b20940aeba 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -74,7 +74,7 @@ module MOM use MOM_dynamics_unsplit, only : MOM_dyn_unsplit_CS use MOM_dynamics_split_RK2, only : step_MOM_dyn_split_RK2, register_restarts_dyn_split_RK2 use MOM_dynamics_split_RK2, only : initialize_dyn_split_RK2, end_dyn_split_RK2 -use MOM_dynamics_split_RK2, only : MOM_dyn_split_RK2_CS +use MOM_dynamics_split_RK2, only : MOM_dyn_split_RK2_CS, remap_dyn_split_rk2_aux_vars use MOM_dynamics_unsplit_RK2, only : step_MOM_dyn_unsplit_RK2, register_restarts_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS @@ -103,14 +103,13 @@ module MOM use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics use MOM_open_boundary, only : ocean_OBC_type, OBC_registry_type -use MOM_open_boundary, only : register_temp_salt_segments -use MOM_open_boundary, only : open_boundary_register_restarts -use MOM_open_boundary, only : update_segment_tracer_reservoirs +use MOM_open_boundary, only : register_temp_salt_segments, update_segment_tracer_reservoirs +use MOM_open_boundary, only : open_boundary_register_restarts, remap_OBC_fields use MOM_open_boundary, only : rotate_OBC_config, rotate_OBC_init use MOM_porous_barriers, only : porous_widths_layer, porous_widths_interface, porous_barriers_init use MOM_porous_barriers, only : porous_barrier_CS -use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML -use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS +use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS +use MOM_set_visc, only : set_visc_register_restarts, remap_vertvisc_aux_vars use MOM_set_visc, only : set_visc_init, set_visc_end use MOM_shared_initialization, only : write_ocean_geometry_file use MOM_sponge, only : init_sponge_diags, sponge_CS @@ -250,6 +249,10 @@ module MOM logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical is set by calling the !! function useRegridding() from the MOM_regridding module. + logical :: remap_aux_vars !< If true, apply ALE remapping to all of the auxiliary 3-D + !! variables that are needed to reproduce across restarts, + !! similarly to what is done with the primary state variables. + type(MOM_stoch_eos_CS) :: stoch_eos_CS !< structure containing random pattern for stoch EOS logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction !! updates occur first in directionally split parts of the calculation. @@ -1547,6 +1550,16 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call ALE_remap_tracers(CS%ALE_CSp, G, GV, h, h_new, CS%tracer_Reg, showCallTree, dtdia, PCM_cell) call ALE_remap_velocities(CS%ALE_CSp, G, GV, h, h_new, u, v, CS%OBC, dzRegrid, showCallTree, dtdia) + if (CS%remap_aux_vars) then + if (CS%split) & + call remap_dyn_split_RK2_aux_vars(G, GV, CS%dyn_split_RK2_CSp, h, h_new, CS%ALE_CSp, CS%OBC, dzRegrid) + + if (associated(CS%OBC)) & + call remap_OBC_fields(G, GV, h, h_new, CS%OBC, PCM_cell=PCM_cell) + + call remap_vertvisc_aux_vars(G, GV, CS%visc, h, h_new, CS%ALE_CSp, CS%OBC) + endif + ! Replace the old grid with new one. All remapping must be done by this point in the code. !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 @@ -2072,6 +2085,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm, & "If True, use the ALE algorithm (regridding/remapping). "//& "If False, use the layered isopycnal algorithm.", default=.false. ) + call get_param(param_file, "MOM", "REMAP_AUXILIARY_VARS", CS%remap_aux_vars, & + "If true, apply ALE remapping to all of the auxiliary 3-dimensional "//& + "variables that are needed to reproduce across restarts, similarly to "//& + "what is already being done with the primary state variables. "//& + "The default should be changed to true.", default=.false., & + do_not_log=.not.CS%use_ALE_algorithm) call get_param(param_file, "MOM", "BULKMIXEDLAYER", bulkmixedlayer, & "If true, use a Kraus-Turner-like bulk mixed layer "//& "with transitional buffer layers. Layers 1 through "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 68f8c97669..f438c14a05 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -36,7 +36,7 @@ module MOM_dynamics_split_RK2 use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) -use MOM_ALE, only : ALE_CS +use MOM_ALE, only : ALE_CS, ALE_remap_velocities use MOM_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source use MOM_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_CS use MOM_barotropic, only : barotropic_end @@ -160,6 +160,9 @@ module MOM_dynamics_split_RK2 !! predictor step. This is used to accomodate various generations !! of restart files. logical :: use_tides !< If true, tidal forcing is enabled. + logical :: remap_aux !< If true, apply ALE remapping to all of the auxiliary 3-D + !! variables that are needed to reproduce across restarts, + !! similarly to what is done with the primary state variables. real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme [nondim] @@ -256,6 +259,7 @@ module MOM_dynamics_split_RK2 public step_MOM_dyn_split_RK2 public register_restarts_dyn_split_RK2 public initialize_dyn_split_RK2 +public remap_dyn_split_RK2_aux_vars public end_dyn_split_RK2 !>@{ CPU time clock IDs @@ -1160,6 +1164,32 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, US, param_file, CS, restart_C end subroutine register_restarts_dyn_split_RK2 +!> This subroutine does remapping for the auxiliary restart variables that are used +!! with the split RK2 time stepping scheme. +subroutine remap_dyn_split_RK2_aux_vars(G, GV, CS, h_old, h_new, ALE_CSp, OBC, dzRegrid) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2] + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure to use when remapping + type(ocean_OBC_type), pointer :: OBC !< OBC control structure to use when remapping + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(in) :: dzRegrid !< Change in interface position [H ~> m or kg m-2] + + if (.not.CS%remap_aux) return + + if (CS%store_CAu) then + call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%u_av, CS%v_av, OBC, dzRegrid) + call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%CAu_pred, CS%CAv_pred, OBC, dzRegrid) + endif + + call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%diffu, CS%diffv, OBC, dzRegrid) + +end subroutine remap_dyn_split_RK2_aux_vars + !> This subroutine initializes all of the variables that are used by this !! dynamic core, including diagnostics and the cpu clocks. subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & @@ -1276,6 +1306,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param "If true, calculate the Coriolis accelerations at the end of each "//& "timestep for use in the predictor step of the next split RK2 timestep.", & default=.true.) + call get_param(param_file, mdl, "REMAP_AUXILIARY_VARS", CS%remap_aux, & + "If true, apply ALE remapping to all of the auxiliary 3-dimensional "//& + "variables that are needed to reproduce across restarts, similarly to "//& + "what is already being done with the primary state variables. "//& + "The default should be changed to true.", default=.false., do_not_log=.true.) + if (CS%remap_aux .and. .not.CS%store_CAu) call MOM_error(FATAL, & + "REMAP_AUXILIARY_VARS requires that STORE_CORIOLIS_ACCEL = True.") call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7d89d97c0f..abe63a950a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -65,6 +65,7 @@ module MOM_open_boundary public open_boundary_register_restarts public update_segment_tracer_reservoirs public update_OBC_ramp +public remap_OBC_fields public rotate_OBC_config public rotate_OBC_init public initialize_segment_data @@ -5408,6 +5409,184 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) end subroutine update_segment_tracer_reservoirs +!> Vertically remap the OBC tracer reservoirs and radiation rates that are filtered in time. +subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: PCM_cell !< Use PCM remapping in cells where true + + ! Local variables + type(OBC_segment_type), pointer :: segment => NULL() ! A pointer to the various segments, used just for shorthand. + + real :: tr_column(GV%ke) ! A column of updated tracer concentrations [CU ~> Conc] + real :: r_norm_col(GV%ke) ! A column of updated radiation rates, in grid points per timestep [nondim] + real :: rxy_col(GV%ke) ! A column of updated radiation rates for oblique OBCs [L2 T-2 ~> m2 s-2] + real :: h1(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h2(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + real :: I_scale ! The inverse of the scaling factor for the tracers. + ! For salinity the units would be [ppt S-1 ~> 1]. + real :: h_neglect ! Tiny thickness used in remapping [H ~> m or kg m-2] + logical :: PCM(GV%ke) ! If true, do PCM remapping from a cell. + integer :: i, j, k, m, n, ntr, nz + + if (.not.associated(OBC)) return + + nz = GV%ke + ntr = OBC%ntr + h_neglect = GV%H_subroundoff + + if (.not.present(PCM_cell)) PCM(:) = .false. + + if (associated(OBC)) then ; if (OBC%OBC_pe) then ; do n=1,OBC%number_of_segments + segment => OBC%segment(n) + if (.not.associated(segment%tr_Reg)) cycle + + if (segment%is_E_or_W) then + I = segment%HI%IsdB + do j=segment%HI%jsd,segment%HI%jed + + ! Store a column of the start and final grids + if (segment%direction == OBC_DIRECTION_W) then + if (G%mask2dT(i+1,j) == 0.0) cycle + h1(:) = h_old(i+1,j,:) + h2(:) = h_new(i+1,j,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i+1,j,:) ; endif + else + if (G%mask2dT(i,j) == 0.0) cycle + h1(:) = h_old(i,j,:) + h2(:) = h_new(i,j,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i,j,:) ; endif + endif + + ! Vertically remap the reservoir tracer concentrations + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale + + if (present(PCM_cell)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(I,j,:), nz, h2, tr_column, & + h_neglect, h_neglect, PCM_cell=PCM) + else + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(I,j,:), nz, h2, tr_column, & + h_neglect, h_neglect) + endif + + ! Possibly underflow any very tiny tracer concentrations to 0? + + ! Update tracer concentrations + segment%tr_Reg%Tr(m)%tres(I,j,:) = tr_column(:) + if (allocated(OBC%tres_x)) then ; do k=1,nz + OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k) + enddo ; endif + + endif ; enddo + + if (segment%radiation .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%rx_norm_rad(I,j,:), nz, h2, r_norm_col, & + h_neglect, h_neglect, PCM_cell=PCM) + + do k=1,nz + segment%rx_norm_rad(I,j,k) = r_norm_col(k) + OBC%rx_normal(I,j,k) = segment%rx_norm_rad(I,j,k) + enddo + endif + + if (segment%oblique .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%rx_norm_obl(I,j,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%rx_norm_obl(I,j,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%ry_norm_obl(I,j,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%ry_norm_obl(I,j,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%cff_normal(I,j,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%cff_normal(I,j,:) = rxy_col(:) + + do k=1,nz + OBC%rx_oblique_u(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique_u(I,j,k) = segment%ry_norm_obl(I,j,k) + OBC%cff_normal_u(I,j,k) = segment%cff_normal(I,j,k) + enddo + endif + + enddo + elseif (segment%is_N_or_S) then + J = segment%HI%JsdB + do i=segment%HI%isd,segment%HI%ied + + ! Store a column of the start and final grids + if (segment%direction == OBC_DIRECTION_S) then + if (G%mask2dT(i,j+1) == 0.0) cycle + h1(:) = h_old(i,j+1,:) + h2(:) = h_new(i,j+1,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i,j+1,:) ; endif + else + if (G%mask2dT(i,j) == 0.0) cycle + h1(:) = h_old(i,j,:) + h2(:) = h_new(i,j,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i,j,:) ; endif + endif + + ! Vertically remap the reservoir tracer concentrations + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale + + if (present(PCM_cell)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(i,J,:), nz, h2, tr_column, & + h_neglect, h_neglect, PCM_cell=PCM) + else + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(i,J,:), nz, h2, tr_column, & + h_neglect, h_neglect) + endif + + ! Possibly underflow any very tiny tracer concentrations to 0? + + ! Update tracer concentrations + segment%tr_Reg%Tr(m)%tres(i,J,:) = tr_column(:) + if (allocated(OBC%tres_y)) then ; do k=1,nz + OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k) + enddo ; endif + + endif ; enddo + + if (segment%radiation .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%ry_norm_rad(i,J,:), nz, h2, r_norm_col, & + h_neglect, h_neglect, PCM_cell=PCM) + + do k=1,nz + segment%ry_norm_rad(i,J,k) = r_norm_col(k) + OBC%ry_normal(i,J,k) = segment%ry_norm_rad(i,J,k) + enddo + endif + + if (segment%oblique .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%rx_norm_obl(i,J,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%rx_norm_obl(i,J,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%ry_norm_obl(i,J,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%ry_norm_obl(i,J,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%cff_normal(i,J,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%cff_normal(i,J,:) = rxy_col(:) + + do k=1,nz + OBC%rx_oblique_v(i,J,k) = segment%rx_norm_obl(i,J,k) + OBC%ry_oblique_v(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal_v(i,J,k) = segment%cff_normal(i,J,k) + enddo + endif + + enddo + endif + enddo ; endif ; endif + +end subroutine remap_OBC_fields + + !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1d2bbbb048..e9497d0e92 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -4,37 +4,39 @@ module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : uvchksum, hchksum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_ALE, only : ALE_CS, ALE_remap_velocities, ALE_remap_interface_vals, ALE_remap_vertex_vals +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_debugging, only : uvchksum, hchksum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_domains, only : pass_var, CORNER +use MOM_domains, only : pass_var, CORNER use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : slasher, MOM_read_data -use MOM_kappa_shear, only : kappa_shear_is_used, kappa_shear_at_vertex -use MOM_cvmix_shear, only : cvmix_shear_is_used -use MOM_cvmix_conv, only : cvmix_conv_is_used -use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used -use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS -use MOM_restart, only : register_restart_field_as_obsolete -use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : slasher, MOM_read_data +use MOM_kappa_shear, only : kappa_shear_is_used, kappa_shear_at_vertex +use MOM_cvmix_shear, only : cvmix_shear_is_used +use MOM_cvmix_conv, only : cvmix_conv_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_restart, only : register_restart_field_as_obsolete +use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_open_boundary, only : OBC_segment_type + implicit none ; private #include public set_viscous_BBL, set_viscous_ML, set_visc_init, set_visc_end -public set_visc_register_restarts +public set_visc_register_restarts, remap_vertvisc_aux_vars ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -1942,6 +1944,34 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) end subroutine set_visc_register_restarts +!> This subroutine does remapping for the auxiliary restart variables in a vertvisc_type +!! that are used across timesteps +subroutine remap_vertvisc_aux_vars(G, GV, visc, h_old, h_new, ALE_CSp, OBC) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + !! viscosities and related fields. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2] + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure to use when remapping + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + + if (associated(visc%Kd_shear)) then + call ALE_remap_interface_vals(ALE_CSp, G, GV, h_old, h_new, visc%Kd_shear) + endif + + if (associated(visc%Kv_shear)) then + call ALE_remap_interface_vals(ALE_CSp, G, GV, h_old, h_new, visc%Kv_shear) + endif + + if (associated(visc%Kv_shear_Bu)) then + call ALE_remap_vertex_vals(ALE_CSp, G, GV, h_old, h_new, visc%Kv_shear_Bu) + endif + +end subroutine remap_vertvisc_aux_vars + !> Initializes the MOM_set_visc control structure subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. @@ -1953,7 +1983,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and - !! related fields. Allocated here. + !! related fields. type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control structure type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure From f162e6f262a3abc04c132401fb0ca420b9fb3b7b Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Thu, 10 Nov 2022 19:47:26 -0700 Subject: [PATCH 029/213] Option to read horizontally varying KHTH from file * Adds the option to set the diffusivity KHTH as horizontally varying * Can be enabled via READ_KHTH = True, filename is provided by user via KHTH_FILE * Will return error if user sets both READ_KHTH = True and KHTH > 0 --- .../lateral/MOM_thickness_diffuse.F90 | 60 +++++++++++++++---- 1 file changed, 49 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c7310e1560..56578bfe2b 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -13,6 +13,7 @@ module MOM_thickness_diffuse use MOM_EOS, only : calculate_density_second_derivs use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS @@ -84,6 +85,8 @@ module MOM_thickness_diffuse real :: Stanley_det_coeff !< The coefficient correlating SGS temperature variance with the mean !! temperature gradient in the deterministic part of the Stanley parameterization. !! Negative values disable the scheme. [nondim] + logical :: read_khth !< If true, read a file containing the spatially varying horizontal + !! thickness diffusivity logical :: use_stanley_gm !< If true, also use the Stanley parameterization in MOM_thickness_diffuse type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics @@ -94,8 +97,9 @@ module MOM_thickness_diffuse real, allocatable :: Kh_eta_u(:,:) !< Interface height diffusivities at u points [L2 T-1 ~> m2 s-1] real, allocatable :: Kh_eta_v(:,:) !< Interface height diffusivities in v points [L2 T-1 ~> m2 s-1] - real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] - real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:) :: khth2d !< 2D thickness diffusivity at h-points [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -171,7 +175,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp "Module must be initialized before it is used.") if ((.not.CS%thickness_diffuse) & - .or. .not. (CS%Khth > 0.0 .or. VarMix%use_variable_mixing)) return + .or. .not. (CS%Khth > 0.0 .or. CS%read_khth & + .or. VarMix%use_variable_mixing)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff @@ -214,10 +219,17 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Set the diffusivities. !$OMP parallel default(shared) - !$OMP do - do j=js,je ; do I=is-1,ie - Khth_loc_u(I,j) = CS%Khth - enddo ; enddo + if (.not. CS%read_khth) then + !$OMP do + do j=js,je ; do I=is-1,ie + Khth_loc_u(I,j) = CS%Khth + enddo ; enddo + else ! use 2d KHTH that was read in from file + !$OMP do + do j=js,je ; do I=is-1,ie + Khth_loc_u(I,j) = 0.5 * (CS%khth2d(i,j) + CS%khth2d(i+1,j)) + enddo ; enddo + endif if (use_VarMix) then if (use_Visbeck) then @@ -302,10 +314,17 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ; enddo endif - !$OMP do - do J=js-1,je ; do i=is,ie - Khth_loc_v(i,J) = CS%Khth - enddo ; enddo + if (.not. CS%read_khth) then + !$OMP do + do J=js-1,je ; do i=is,ie + Khth_loc_v(i,J) = CS%Khth + enddo ; enddo + else ! read KHTH from file + !$OMP do + do J=js-1,je ; do i=is,ie + Khth_loc_v(i,J) = 0.5 * (CS%khth2d(i,j) + CS%khth2d(i,j+1)) + enddo ; enddo + endif if (use_VarMix) then if (use_Visbeck) then @@ -1944,6 +1963,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! Local variables character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. + character(len=200) :: khth_file ! file containing 2d KHTH ! This include declares and sets the variable "version". # include "version_variable.h" real :: grid_sp ! The local grid spacing [L ~> m] @@ -1969,6 +1989,22 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) + call get_param(param_file, mdl, "READ_KHTH", CS%read_khth, & + "If true, read a file (given by KHTH_FILE) containing the "//& + "spatially varying horizontal thickness diffusivity.", default=.false.) + if (CS%read_khth) then + if (CS%Khth > 0) then + call MOM_error(FATAL, "thickness_diffuse_init: KHTH > 0 is not "// & + "compatible with READ_KHTH = TRUE. ") + endif + call get_param(param_file, mdl, "KHTH_FILE", khth_file, & + "The file containing the spatially varying horizontal "//& + "thickness diffusivity.", default="INPUT/khth.nc") + + allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + call MOM_read_data(khth_file, 'khth', CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call pass_var(CS%khth2d, G%domain) + endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & @@ -2219,6 +2255,8 @@ subroutine thickness_diffuse_end(CS, CDp) deallocate(CS%KH_u_GME) deallocate(CS%KH_v_GME) endif + + if (allocated(CS%khth2d)) deallocate(CS%khth2d) end subroutine thickness_diffuse_end !> \namespace mom_thickness_diffuse From ca4469231dc7736c8dafa8a4d6b746a018b5122d Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Mon, 14 Nov 2022 11:39:53 -0700 Subject: [PATCH 030/213] Allow KHTH_FILE directory to be set independently * full file path is now set as INPUTDIR/KHTH_FILE, where both INPUTDIR and KHTH_FILE are runtime parameters --- .../lateral/MOM_thickness_diffuse.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 56578bfe2b..11d0a328ae 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -13,7 +13,7 @@ module MOM_thickness_diffuse use MOM_EOS, only : calculate_density_second_derivs use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_io, only : MOM_read_data +use MOM_io, only : MOM_read_data, slasher use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS @@ -1963,7 +1963,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! Local variables character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - character(len=200) :: khth_file ! file containing 2d KHTH + character(len=200) :: khth_file, inputdir ! This include declares and sets the variable "version". # include "version_variable.h" real :: grid_sp ! The local grid spacing [L ~> m] @@ -1997,9 +1997,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call MOM_error(FATAL, "thickness_diffuse_init: KHTH > 0 is not "// & "compatible with READ_KHTH = TRUE. ") endif + call get_param(param_file, mdl, "INPUTDIR", inputdir, & + "The directory in which all input files are found.", & + default=".", do_not_log=.true.) + inputdir = slasher(inputdir) call get_param(param_file, mdl, "KHTH_FILE", khth_file, & "The file containing the spatially varying horizontal "//& - "thickness diffusivity.", default="INPUT/khth.nc") + "thickness diffusivity.", default="khth.nc") + khth_file = trim(inputdir) // trim(khth_file) allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) call MOM_read_data(khth_file, 'khth', CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) From ca7207ec5e7217c3b5c9d67a12d2b28a171a0ff0 Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Mon, 14 Nov 2022 11:49:38 -0700 Subject: [PATCH 031/213] Add parameter that specifies name of khth variable in file --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 11d0a328ae..6a57c60d41 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1963,7 +1963,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! Local variables character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - character(len=200) :: khth_file, inputdir + character(len=200) :: khth_file, inputdir, khth_varname ! This include declares and sets the variable "version". # include "version_variable.h" real :: grid_sp ! The local grid spacing [L ~> m] @@ -2004,10 +2004,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KHTH_FILE", khth_file, & "The file containing the spatially varying horizontal "//& "thickness diffusivity.", default="khth.nc") + call get_param(param_file, mdl, "KHTH_VARIABLE", khth_varname, & + "The name of the interface height diffusivity variable to read "//& + "from KHTH_FILE.", & + default="khth") khth_file = trim(inputdir) // trim(khth_file) allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) - call MOM_read_data(khth_file, 'khth', CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call MOM_read_data(khth_file, khth_varname, CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%khth2d, G%domain) endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & From 20701750f1f585a68cb37f9002f5c8f44685feba Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Mon, 14 Nov 2022 11:57:17 -0700 Subject: [PATCH 032/213] Change terminology in comments thickness diffusivity --> isopycnal height diffusivity --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 6a57c60d41..b30d24eeaf 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -99,7 +99,7 @@ module MOM_thickness_diffuse real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] - real, allocatable, dimension(:,:) :: khth2d !< 2D thickness diffusivity at h-points [L2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:) :: khth2d !< 2D isopycnal height diffusivity at h-points [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -1991,7 +1991,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "READ_KHTH", CS%read_khth, & "If true, read a file (given by KHTH_FILE) containing the "//& - "spatially varying horizontal thickness diffusivity.", default=.false.) + "spatially varying horizontal isopycnal height diffusivity.", & + default=.false.) if (CS%read_khth) then if (CS%Khth > 0) then call MOM_error(FATAL, "thickness_diffuse_init: KHTH > 0 is not "// & @@ -2003,9 +2004,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) inputdir = slasher(inputdir) call get_param(param_file, mdl, "KHTH_FILE", khth_file, & "The file containing the spatially varying horizontal "//& - "thickness diffusivity.", default="khth.nc") + "isopycnal height diffusivity.", default="khth.nc") call get_param(param_file, mdl, "KHTH_VARIABLE", khth_varname, & - "The name of the interface height diffusivity variable to read "//& + "The name of the isopycnal height diffusivity variable to read "//& "from KHTH_FILE.", & default="khth") khth_file = trim(inputdir) // trim(khth_file) From 6eab2b603886aaf1694753300d4f24533a0ec884 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 14 Nov 2022 18:55:15 -0500 Subject: [PATCH 033/213] +Correct reported units for 4 diagnostics Corrected the units written to the output files for 4 diagnostics (CAu_Stokes, CAv_Stokes, area_shelf_h and sfc_mass_flux) and added missing units arguments to the get_param calls for some (mostly unlogged) parameters. The logged calls where units are added include those for EKE_MAX, NDIFF_DRHO_TOL, NDIFF_X_TOL, and IMPULSE_SOURCE_TIME, while some unnecessary carriage returns were removed in the descriptions of some of these and closely related parameters. Also added units to the comment describing the AGlen argument to initialize_ice_AGlen. All answers are bitwise identical, but there can be minor changes in the metadata of some files, and some MOM_parameter_doc and available_diags files might exhibit minor changes. --- src/core/MOM_CoriolisAdv.F90 | 8 +++--- src/ice_shelf/MOM_ice_shelf.F90 | 7 +++-- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 18 +++++------- .../MOM_fixed_initialization.F90 | 2 +- .../MOM_state_initialization.F90 | 6 ++-- src/parameterizations/lateral/MOM_MEKE.F90 | 3 +- src/tracer/MOM_neutral_diffusion.F90 | 28 +++++++++---------- src/tracer/boundary_impulse_tracer.F90 | 2 +- 8 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 3289786fd0..3ee203210c 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -1212,11 +1212,11 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_CAuS = register_diag_field('ocean_model', 'CAu_Stokes', diag%axesCuL, Time, & - 'Zonal Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Stokes Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) ! add to AD CS%id_CAvS = register_diag_field('ocean_model', 'CAv_Stokes', diag%axesCvL, Time, & - 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Stokes Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) ! add to AD !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & @@ -1249,14 +1249,14 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) !CS%id_hf_rvxu = register_diag_field('ocean_model', 'hf_rvxu', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxu_2d = register_diag_field('ocean_model', 'hf_rvxu_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxv_2d = register_diag_field('ocean_model', 'hf_rvxv_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 1a29ef45e6..ab73675bb1 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1694,7 +1694,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file !if (.not. CS%solo_ice_sheet) then ! call register_restart_field(fluxes%ustar_shelf, "ustar_shelf", .false., CS%restart_CSp, & - ! "Friction velocity under ice shelves", "m s-1", conversion=###) + ! "Friction velocity under ice shelves", "m s-1", conversion=US%Z_to_m*US%s_to_T) !endif CS%restart_output_dir = dirs%restart_output_dir @@ -1797,7 +1797,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, endif CS%id_area_shelf_h = register_diag_field('ice_shelf_model', 'area_shelf_h', CS%diag%axesT1, CS%Time, & - 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) + 'Ice Shelf Area in cell', 'meter2', conversion=US%L_to_m**2) CS%id_shelf_mass = register_diag_field('ice_shelf_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & 'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2) CS%id_h_shelf = register_diag_field('ice_shelf_model', 'h_shelf', CS%diag%axesT1, CS%Time, & @@ -1839,7 +1839,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, CS%id_h_mask = register_diag_field('ice_shelf_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') CS%id_shelf_sfc_mass_flux = register_diag_field('ice_shelf_model', 'sfc_mass_flux', CS%diag%axesT1, CS%Time, & - 'ice shelf surface mass flux deposition from atmosphere', 'none', conversion=US%RZ_T_to_kg_m2s) + 'ice shelf surface mass flux deposition from atmosphere', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) endif call MOM_IS_diag_mediator_close_registration(CS%diag) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 2de064e93e..e49fb03aaf 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -318,13 +318,10 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises - call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) - - call get_param(PF, mdl, "LENLON", lenlon, fail_if_missing=.true.) - - call get_param(PF, mdl, "WESTLON", westlon, fail_if_missing=.true.) - - call get_param(PF, mdl, "SOUTHLAT", southlat, fail_if_missing=.true.) + lenlat = G%len_lat + lenlon = G%len_lon + westlon = G%west_lon + southlat = G%south_lat call get_param(PF, mdl, "INPUT_VEL_ICE_SHELF", input_vel, & "inflow ice velocity at upstream boundary", & @@ -619,12 +616,11 @@ subroutine initialize_ice_C_basal_friction(C_basal_friction, G, US, PF) subroutine initialize_ice_AGlen(AGlen, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: AGlen !< The ice-stiffness parameter A_Glen + intent(inout) :: AGlen !< The ice-stiffness parameter A_Glen, often in [Pa-3 s-1] type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters -! integer :: i, j - real :: A_Glen + real :: A_Glen ! Ice-stiffness parameter, often in [Pa-3 s-1] character(len=40) :: mdl = "initialize_ice_stiffness" ! This subroutine's name. character(len=200) :: config character(len=200) :: varname @@ -657,7 +653,7 @@ subroutine initialize_ice_AGlen(AGlen, G, US, PF) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_stiffness_from_file: Unable to open "//trim(filename)) - call MOM_read_data(filename,trim(varname),AGlen,G%Domain) + call MOM_read_data(filename,trim(varname), AGlen, G%Domain) endif end subroutine diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 88c6377abc..16702b6901 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -220,7 +220,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - max_depth = -1.e9*US%m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=US%m_to_Z) + call get_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, units="m", default=-1.e9, scale=US%m_to_Z, do_not_log=.true.) select case ( trim(config) ) case ("file"); call initialize_topography_from_file(D, G, PF, US) case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f8beb4927..d3e8a2b18a 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -496,7 +496,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "an initial grid that is consistent with the initial conditions.", & default=1, do_not_log=just_read) - call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true., scale=US%s_to_T) + call get_param(PF, mdl, "DT", dt, "Timestep", & + units="s", scale=US%s_to_T, fail_if_missing=.true.) if (new_sim .and. debug) & call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m) @@ -2678,7 +2679,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "all layers are initialized based on the depths of their target densities.", & default=.false., do_not_log=just_read.or.(GV%nkml==0)) if (GV%nkml == 0) separate_mixed_layer = .false. - call get_param(PF, mdl, "MINIMUM_DEPTH", Hmix_default, default=0.0) + call get_param(PF, mdl, "MINIMUM_DEPTH", Hmix_default, & + units="m", default=0.0, scale=1.0) call get_param(PF, mdl, "Z_INIT_HMIX_DEPTH", Hmix_depth, & "The mixed layer depth in the initial conditions when Z_INIT_SEPARATE_MIXED_LAYER "//& "is set to true.", default=Hmix_default, units="m", scale=US%m_to_Z, & diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index ead6086346..e25a333c7a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1522,7 +1522,8 @@ subroutine ML_MEKE_init(diag, G, US, Time, param_file, dbcomms_CS, CS) call get_param(param_file, mdl, "EKE_MODEL", model_filename, & "Filename of the a saved pyTorch model to use", fail_if_missing = .true.) call get_param(param_file, mdl, "EKE_MAX", CS%eke_max, & - "Maximum value of EKE allowed when inferring EKE", default=2., scale=US%L_T_to_m_s**2) + "Maximum value of EKE allowed when inferring EKE", & + units="m2 s-2", default=2., scale=US%L_T_to_m_s**2) ! Set the machine learning model if (dbcomms_CS%colocated) then diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 9ef59821e3..cd29e9a536 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -48,7 +48,7 @@ module MOM_neutral_diffusion logical :: hard_fail_heff !< Bring down the model if a problem with heff is detected integer :: max_iter !< Maximum number of iterations if refine_position is defined real :: drho_tol !< Convergence criterion representing density difference from true neutrality [R ~> kg m-3] - real :: x_tol !< Convergence criterion for how small an update of the position can be + real :: x_tol !< Convergence criterion for how small an update of the position can be [nondim] real :: ref_pres !< Reference pressure, negative if using locally referenced neutral !! density [R L2 T-2 ~> Pa] logical :: interior_only !< If true, only applies neutral diffusion in the ocean interior. @@ -56,15 +56,15 @@ module MOM_neutral_diffusion logical :: use_unmasked_transport_bug !< If true, use an older form for the accumulation of !! neutral-diffusion transports that were unmasked, as used prior to Jan 2018. ! Positions of neutral surfaces in both the u, v directions - real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point - real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point + real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point [nondim] + real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point [nondim] integer, allocatable, dimension(:,:,:) :: uKoL !< Index of left interface corresponding to neutral surface, !! at a u-point integer, allocatable, dimension(:,:,:) :: uKoR !< Index of right interface corresponding to neutral surface, !! at a u-point real, allocatable, dimension(:,:,:) :: uHeff !< Effective thickness at u-point [H ~> m or kg m-2] - real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point - real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point + real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point [nondim] + real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point [nondim] integer, allocatable, dimension(:,:,:) :: vKoL !< Index of left interface corresponding to neutral surface, !! at a v-point integer, allocatable, dimension(:,:,:) :: vKoR !< Index of right interface corresponding to neutral surface, @@ -229,16 +229,16 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, " pressure dependence", & default="mid_pressure") if (CS%neutral_pos_method > 1) then - call get_param(param_file, mdl, "NDIFF_DRHO_TOL", CS%drho_tol, & - "Sets the convergence criterion for finding the neutral\n"// & - "position within a layer in kg m-3.", & - default=1.e-10, scale=US%kg_m3_to_R) - call get_param(param_file, mdl, "NDIFF_X_TOL", CS%x_tol, & - "Sets the convergence criterion for a change in nondim\n"// & - "position within a layer.", & - default=0.) + call get_param(param_file, mdl, "NDIFF_DRHO_TOL", CS%drho_tol, & + "Sets the convergence criterion for finding the neutral "// & + "position within a layer in kg m-3.", & + units="kg m-3", default=1.e-10, scale=US%kg_m3_to_R) + call get_param(param_file, mdl, "NDIFF_X_TOL", CS%x_tol, & + "Sets the convergence criterion for a change in nondimensional "// & + "position within a layer.", & + units="nondim", default=0.) call get_param(param_file, mdl, "NDIFF_MAX_ITER", CS%max_iter, & - "The maximum number of iterations to be done before \n"// & + "The maximum number of iterations to be done before "// & "exiting the iterative loop to find the neutral surface", & default=10) endif diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index a7066c1ab8..2a3727bdca 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -98,7 +98,7 @@ function register_boundary_impulse_tracer(HI, GV, US, param_file, CS, tr_Reg, re "Length of time for the boundary tracer to be injected "//& "into the mixed layer. After this time has elapsed, the "//& "surface becomes a sink for the boundary impulse tracer.", & - default=31536000.0, scale=US%s_to_T) + units="s", default=31536000.0, scale=US%s_to_T) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code "//& "if they are not found in the restart files. Otherwise "//& From 6765e27e0c4d0961f5e8b3bdfc5d849b4007e3dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 14 Nov 2022 19:56:45 -0500 Subject: [PATCH 034/213] (*)Rescale DENSE_WATER_EAST_SPONGE_SALT Added a missing scale factor in the DENSE_WATER_EAST_SPONGE_SALT get_param call in dense_water_initialize_sponges, and added comments describing the local variables (and their units) throughout the dense_water_initialization module. The variable set by DENSE_WATER_SILL_HEIGHT was unused and it probably was always intended to be DENSE_WATER_SILL_DEPTH, which it now is. Units arguments were also added to two of the unlogged get_param calls in this module. Without this change, this test case would not reproduce with dimensional rescaling due to a scale factor that was omitted when salinity was being rescaled on May 3, 2022, which became a part of PR #122 to dev/gfdl, but answers should not change when dimensional rescaling of salinities is not used. All answers and output in the MOM6-examples test suite are bitwise identical. --- src/user/dense_water_initialization.F90 | 68 +++++++++++++++---------- 1 file changed, 41 insertions(+), 27 deletions(-) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index a81c400256..5e0cb65007 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -40,10 +40,13 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units ! Local variables - real, dimension(5) :: domain_params ! nondimensional widths of all domain sections - real :: sill_frac, shelf_frac + real, dimension(5) :: domain_params ! nondimensional widths of all domain sections [nondim] + real :: sill_frac ! Depth of the sill separating downslope from upslope, as a fraction of + ! the basin depth [nondim] + real :: shelf_frac ! Depth of the shelf region accumulating dense water for overflow, + ! as a fraction the basin depth [nondim] + real :: x ! Horizontal position normalized by the domain width [nondim] integer :: i, j - real :: x call get_param(param_file, mdl, "DENSE_WATER_DOMAIN_PARAMS", domain_params, & "Fractional widths of all the domain sections for the dense water experiment.\n"//& @@ -106,8 +109,10 @@ subroutine dense_water_initialize_TS(G, GV, US, param_file, T, S, h, just_read) logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables - real :: mld, S_ref, S_range, T_ref - real :: zi, zmid + real :: mld ! The initial mixed layer depth as a fraction of the maximum depth [nondim] + real :: S_ref, S_range ! The reference salinity and its range in the initial conditions [S ~> ppt] + real :: T_ref ! The reference temperature [C ~> degC] + real :: zi, zmid ! Depths from the surface nondimensionalized by the maximum depth [nondim] integer :: i, j, k, nz nz = GV%ke @@ -160,43 +165,52 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, logical, intent(in) :: use_ALE !< ALE flag type(sponge_CS), pointer :: CSp !< Layered sponge control structure pointer type(ALE_sponge_CS), pointer :: ACSp !< ALE sponge control structure pointer + ! Local variables real :: west_sponge_time_scale, east_sponge_time_scale ! Sponge timescales [T ~> s] - real :: west_sponge_width, east_sponge_width + real :: west_sponge_width ! The fraction of the domain in which the western (outflow) sponge is active [nondim] + real :: east_sponge_width ! The fraction of the domain in which the eastern (outflow) sponge is active [nondim] real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T ! sponge temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinity [S ~> ppt] real, dimension(SZK_(GV)+1) :: e0, eta1D ! interface positions for ALE sponge [Z ~> m] - + real :: x ! Horizontal position normalized by the domain width [nondim] + real :: zi, zmid ! Depths from the surface nondimensionalized by the maximum depth [nondim] + real :: dist ! Distance from the edge of a sponge normalized by the width of that sponge [nondim] + real :: mld ! The initial mixed layer depth as a fraction of the maximum depth [nondim] + real :: S_ref, S_range ! The reference salinity and its range in the initial conditions [S ~> ppt] + real :: S_dense ! The salinity of the dense water being formed on the shelf [S ~> ppt] + real :: T_ref ! The reference temperature [C ~> degC] + real :: sill_frac ! Fractional depths of the sill, relative to the maximum depth [nondim] integer :: i, j, k, nz - real :: x, zi, zmid, dist - real :: mld, S_ref, S_range, S_dense, T_ref, sill_height nz = GV%ke call get_param(param_file, mdl, "DENSE_WATER_WEST_SPONGE_TIME_SCALE", west_sponge_time_scale, & - "The time scale on the west (outflow) of the domain for restoring. If zero, the sponge is disabled.", & - units="s", default=0., scale=US%s_to_T) + "The time scale on the west (outflow) of the domain for restoring. "//& + "If zero, the sponge is disabled.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "DENSE_WATER_WEST_SPONGE_WIDTH", west_sponge_width, & - "The fraction of the domain in which the western (outflow) sponge is active.", & - units="nondim", default=0.1) + "The fraction of the domain in which the western (outflow) sponge is active.", & + units="nondim", default=0.1) call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_TIME_SCALE", east_sponge_time_scale, & - "The time scale on the east (outflow) of the domain for restoring. If zero, the sponge is disabled.", & - units="s", default=0., scale=US%s_to_T) + "The time scale on the east (outflow) of the domain for restoring. "//& + "If zero, the sponge is disabled.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_WIDTH", east_sponge_width, & - "The fraction of the domain in which the eastern (outflow) sponge is active.", & - units="nondim", default=0.1) - + "The fraction of the domain in which the eastern (outflow) sponge is active.", & + units="nondim", default=0.1) call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_SALT", S_dense, & - "Salt anomaly of the dense water being formed in the overflow region.", & - units="1e-3", default=4.0) + "Salt anomaly of the dense water being formed in the overflow region.", & + units="1e-3", default=4.0, scale=US%ppt_to_S) - call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, default=default_mld, do_not_log=.true.) - call get_param(param_file, mdl, "DENSE_WATER_SILL_HEIGHT", sill_height, default=default_sill, do_not_log=.true.) + call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, & + units="nondim", default=default_mld, do_not_log=.true.) + call get_param(param_file, mdl, "DENSE_WATER_SILL_DEPTH", sill_frac, & + units="nondim", default=default_sill, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "S_RANGE", S_range, & units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "T_REF", T_ref, & @@ -266,12 +280,12 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (x > (1. - east_sponge_width)) then - !if (zmid >= 0.9 * sill_height) & - S(i,j,k) = S_ref + S_dense + !if (zmid >= 0.9 * sill_frac) & + S(i,j,k) = S_ref + S_dense else ! linear between bottom of mixed layer and bottom if (zmid >= mld) & - S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) + S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) @@ -300,7 +314,7 @@ end module dense_water_initialization !! The nondimensional widths of the 5 regions are controlled by the !! DENSE_WATER_DOMAIN_PARAMS, and the heights of the sill and shelf !! as a fraction of the total domain depth are controlled by -!! DENSE_WATER_SILL_HEIGHT and DENSE_WATER_SHELF_HEIGHT. +!! DENSE_WATER_SILL_DEPTH and DENSE_WATER_SHELF_DEPTH. !! !! The density in the domain is governed by a linear equation of state, and !! is set up with a mixed layer of non-dimensional depth DENSE_WATER_MLD From 321e0eb0af7cf988c1b7e96785a4ed6f93a713ad Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 15 Nov 2022 09:25:59 -0500 Subject: [PATCH 035/213] +Removed 31 meaningless get_param units Removed meaningless units arguments from 31 get_param calls for integer, character, or logical parameters. All answers are bitwise identical, but some entries in the various parameter_doc files are changed. --- .../drivers/solo_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM_barotropic.F90 | 2 +- src/framework/MOM_unit_scaling.F90 | 14 +++++++------- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 6 +++--- .../vertical/MOM_energetic_PBL.F90 | 5 ++--- src/parameterizations/vertical/MOM_kappa_shear.F90 | 4 ++-- src/user/MOM_wave_interface.F90 | 12 ++++++------ src/user/dumbbell_initialization.F90 | 10 +++++----- src/user/dumbbell_surface_forcing.F90 | 2 +- 12 files changed, 32 insertions(+), 33 deletions(-) diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index c1e125be83..7fab9e5c8c 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -1728,7 +1728,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "USTAR_FORCING_VAR", CS%ustar_var, & "The name of the friction velocity variable in WIND_FILE "//& "or blank to get ustar from the wind stresses plus the "//& - "gustiness.", default=" ", units="nondim") + "gustiness.", default=" ") CS%wind_file = trim(CS%inputdir) // trim(CS%wind_file) endif if (trim(CS%wind_config) == "gyres") then diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 0949d203ae..44711e6526 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4432,7 +4432,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "If NONLINEAR_BT_CONTINUITY is true, this is the number "//& "of barotropic time steps between updates to the face "//& "areas, or 0 to update only before the barotropic stepping.", & - units="nondim", default=1, do_not_log=.not.CS%Nonlinear_continuity) + default=1, do_not_log=.not.CS%Nonlinear_continuity) call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& "If true, step the barotropic velocity first and project "//& diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index 6defa492a8..caf73ae8e1 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -89,31 +89,31 @@ subroutine unit_scaling_init( param_file, US ) call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of depths and heights. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "L_RESCALE_POWER", L_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of lateral distances. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "T_RESCALE_POWER", T_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of time. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "R_RESCALE_POWER", R_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of density. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "Q_RESCALE_POWER", Q_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of heat content. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "C_RESCALE_POWER", C_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of temperature. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "S_RESCALE_POWER", S_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of salinity. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index e25a333c7a..18c156e1f1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1267,7 +1267,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, call get_param(param_file, mdl, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & "If true, the length scale used by MEKE is the minimum of "//& "the deformation radius or grid-spacing. Only used if "//& - "MEKE_OLD_LSCALE=True", units="nondim", default=.false.) + "MEKE_OLD_LSCALE=True", default=.false.) call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF_KU", CS%viscosity_coeff_Ku, & "If non-zero, is the scaling coefficient in the expression for"//& "viscosity used to parameterize harmonic lateral momentum mixing by"//& diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 825ca412d1..d118f625bf 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1995,7 +1995,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) if (CS%use_GME) then call get_param(param_file, mdl, "GME_NUM_SMOOTHINGS", CS%num_smooth_gme, & "Number of smoothing passes for the GME fluxes.", & - units="nondim", default=1) + default=1) call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & "The strength of GME tapers quadratically to zero when the bathymetric "//& "depth is shallower than GME_H0.", & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 87562a9c83..50ddd224ed 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1350,7 +1350,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "positive integer may be used, although even integers "//& "are more efficient to calculate. Setting this greater "//& "than 100 results in a step-function being used.", & - units="nondim", default=2) + default=2) call get_param(param_file, mdl, "VISC_RES_SCALE_COEF", CS%Res_coef_visc, & "A coefficient that determines how Kh is scaled away if "//& "RESOLN_SCALED_... is true, as "//& @@ -1363,7 +1363,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "are more efficient to calculate. Setting this greater "//& "than 100 results in a step-function being used. "//& "This function affects lateral viscosity, Kh, and not KhTh.", & - units="nondim", default=CS%Res_fn_power_khth) + default=CS%Res_fn_power_khth) call get_param(param_file, mdl, "INTERPOLATE_RES_FN", CS%interpolate_Res_fn, & "If true, interpolate the resolution function to the "//& "velocity points from the thickness points; otherwise "//& diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index c68da61abf..1e068509b1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -388,10 +388,10 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) !/ 1. Options related to enhancing the mixing coefficient call get_param(paramFile, mdl, "USE_KPP_LT_K", CS%LT_K_Enhancement, & 'Flag for Langmuir turbulence enhancement of turbulent'//& - 'mixing coefficient.', units="", Default=.false.) + 'mixing coefficient.', Default=.false.) call get_param(paramFile, mdl, "STOKES_MIXING", CS%Stokes_Mixing, & 'Flag for Langmuir turbulence enhancement of turbulent'//& - 'mixing coefficient.', units="", Default=.false.) + 'mixing coefficient.', Default=.false.) if (CS%LT_K_Enhancement) then call get_param(paramFile, mdl, 'KPP_LT_K_SHAPE', string, & 'Vertical dependence of LT enhancement of mixing. '// & @@ -438,7 +438,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) !/ 2. Options related to enhancing the unresolved Vt2/entrainment in Rib call get_param(paramFile, mdl, "USE_KPP_LT_VT2", CS%LT_Vt2_Enhancement, & 'Flag for Langmuir turbulence enhancement of Vt2'//& - 'in Bulk Richardson Number.', units="", Default=.false.) + 'in Bulk Richardson Number.', Default=.false.) if (CS%LT_Vt2_Enhancement) then call get_param(paramFile, mdl, "KPP_LT_VT2_METHOD",string , & 'Method to enhance Vt2 in KPP. '// & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 862f775225..852ff4cee1 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2222,14 +2222,13 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Options related to Langmuir turbulence call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& - "determine the Langmuir number.", units="nondim", default=.false.) + "determine the Langmuir number.", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. if (use_LA_windsea) then CS%use_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%use_LT, & - "A logical to use a LT parameterization.", & - units="nondim", default=.false.) + "A logical to use a LT parameterization.", default=.false.) endif if (CS%use_LT) then call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 118ec9a1a1..c088eea5bb 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1775,7 +1775,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MAX_RINO_IT", CS%max_RiNo_it, & "The maximum number of iterations that may be used to "//& "estimate the Richardson number driven mixing.", & - units="nondim", default=50, do_not_log=just_read) + default=50, do_not_log=just_read) call get_param(param_file, mdl, "KD", KD_normal, default=0.0, do_not_log=.true.) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the "//& @@ -1831,7 +1831,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) default=.true., do_not_log=just_read) call get_param(param_file, mdl, "MAX_KAPPA_SHEAR_IT", CS%max_KS_it, & "The maximum number of iterations that may be used to "//& - "estimate the time-averaged diffusivity.", units="nondim", & + "estimate the time-averaged diffusivity.", & default=13, do_not_log=just_read) call get_param(param_file, mdl, "PRANDTL_TURB", CS%Prandtl_turb, & "The turbulent Prandtl number applied to shear instability.", & diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index a423ddc8b8..6676addc56 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -317,22 +317,22 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar endif call get_param(param_file, mdl, "STOKES_VF", CS%Stokes_VF, & - "Flag to use Stokes vortex force", units="", & + "Flag to use Stokes vortex force", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_VF", CS%Passive_Stokes_VF, & - "Flag to make Stokes vortex force diagnostic only.", units="", & + "Flag to make Stokes vortex force diagnostic only.", & Default=.false.) call get_param(param_file, mdl, "STOKES_PGF", CS%Stokes_PGF, & - "Flag to use Stokes-induced pressure gradient anomaly", units="", & + "Flag to use Stokes-induced pressure gradient anomaly", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_PGF", CS%Passive_Stokes_PGF, & - "Flag to make Stokes-induced pressure gradient anomaly diagnostic only.", units="", & + "Flag to make Stokes-induced pressure gradient anomaly diagnostic only.", & Default=.false.) call get_param(param_file, mdl, "STOKES_DDT", CS%Stokes_DDT, & - "Flag to use Stokes d/dt", units="", & + "Flag to use Stokes d/dt", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_DDT", CS%Passive_Stokes_DDT, & - "Flag to make Stokes d/dt diagnostic only", units="", & + "Flag to make Stokes d/dt diagnostic only", & Default=.false.) ! Get Wave Method and write to integer WaveMethod diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 762477b6c4..90d745004b 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -58,7 +58,7 @@ subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) units='nondim', default=0.5, do_not_log=.false.) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=.false.) + default=.false., do_not_log=.false.) if (G%x_axis_units == 'm') then dblen=dblen*1.e3 @@ -150,7 +150,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, case ( REGRIDDING_LAYER) ! Initial thicknesses for isopycnal coordinates call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=just_read) + default=.false., do_not_log=just_read) do j=js,je do i=is,ie ! Compute normalized zonal coordinates (x,y=0 at center of domain) @@ -293,7 +293,7 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ units='km', default=600., do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=just_read) + default=.false., do_not_log=just_read) if (G%x_axis_units == 'm') then dblen = dblen*1.e3 @@ -361,7 +361,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil units='km', default=600., do_not_log=.true.) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=.true.) + default=.false., do_not_log=.true.) if (G%x_axis_units == 'm') then dblen=dblen*1.e3 @@ -470,4 +470,4 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil end subroutine dumbbell_initialize_sponges -end module dumbbell_initialization \ No newline at end of file +end module dumbbell_initialization diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index a672a4378b..685ffc4bee 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -216,7 +216,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) units="days", default=1.0) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.',& - units='nondim', default=.false., do_not_log=.true.) + default=.false., do_not_log=.true.) call get_param(param_file, mdl,"INITIAL_SSS", S_surf, & "Initial surface salinity", & units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=.true.) From 7a962e58962723aa238688711c2332f772168440 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 23 Nov 2022 17:40:54 -0500 Subject: [PATCH 036/213] .testing: Fix concurrency errors in tc4 rules This patch fixes two issues in the preprocessing of tc4. * ocean_hgrid.nc is marked as a dependency of gen_data * Multiple ouputs are handled more safely in the Makefile Expanding on the second point: We were directing one rule to produce two output files, which resulted in the rule being run twice when invoked in parallel (make -j). This has been replaced with the recommended solution for handling concurrent outputs: use one to generate both, and connect the second to the first with a separate rule. I have also generalized the `make` command in the .testing Makefile. This should address (and hopefully fix) some intermittent errors in the .testing build on Gaea. --- .testing/Makefile | 2 +- .testing/tc4/Makefile.in | 33 +++++++++++++++++++++++++++------ 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 3e5c174239..73a97229d4 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -522,7 +522,7 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # NOTE: This only support tc4, but can be generalized over all tests. .PHONY: preproc preproc: tc4/Makefile - cd tc4 && make + cd tc4 && $(MAKE) LAUNCHER="$(MPIRUN)" tc4/Makefile: tc4/configure tc4/Makefile.in cd $(@D) && ./configure || (cat config.log && false) diff --git a/.testing/tc4/Makefile.in b/.testing/tc4/Makefile.in index 249d86b0b6..5a0e441482 100644 --- a/.testing/tc4/Makefile.in +++ b/.testing/tc4/Makefile.in @@ -4,15 +4,33 @@ FCFLAGS = @FCFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ -OUT = topog.nc ocean_hgrid.nc temp_salt_ic.nc sponge.nc +LAUNCHER ?= -all: $(OUT) +OUT = ocean_hgrid.nc topog.nc temp_salt_ic.nc sponge.nc -ocean_hgrid.nc topog.nc: gen_grid - ./gen_grid +# Since each program generates two outputs, we can only use one to track the +# creation. The second rule is used to indirectly re-invoke the first rule. +# +# Reference: +# https://www.gnu.org/software/automake/manual/html_node/Multiple-Outputs.html -temp_salt_ic.nc sponge.nc: gen_data - ./gen_data +# Program output +all: ocean_hgrid.nc temp_salt_ic.nc + +ocean_hgrid.nc: gen_grid + $(LAUNCHER) ./gen_grid +topog.nc: ocean_hgrid.nc + @test -f $@ || rm -f $^ + @test -f $@ || $(MAKE) $^ + +temp_salt_ic.nc: gen_data ocean_hgrid.nc + $(LAUNCHER) ./gen_data +sponge.nc: temp_salt_ic.nc + @test -f $@ || rm -f $^ + @test -f $@ || $(MAKE) $^ + + +# Programs gen_grid: gen_grid.F90 $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) @@ -20,6 +38,9 @@ gen_grid: gen_grid.F90 gen_data: gen_data.F90 $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) + +# Support + .PHONY: clean clean: rm -rf $(OUT) gen_grid gen_data From 6bf43d66042ee95ab4914496e2fa253c95bf79f5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 15 Nov 2022 13:46:26 -0500 Subject: [PATCH 037/213] Better document parameter units in 4 user modules Add units arguments to 30 unlogged get_param calls in 4 user modules (DOME2d_initialization, ISOMIP_initialization, Kelvin_initialization and seamount_initialization) to help detect inconsistent units and scaling factors. Also added comments describing many internal real variables and their units in the DOME2d_initialization module and seamount_initialize_temperature_salinity. All answers and output are bitwise identical. --- src/user/DOME2d_initialization.F90 | 80 ++++++++++++++++------------ src/user/ISOMIP_initialization.F90 | 16 +++--- src/user/Kelvin_initialization.F90 | 12 ++--- src/user/seamount_initialization.F90 | 34 ++++++++---- 4 files changed, 85 insertions(+), 57 deletions(-) diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a997cde26b..1c2b71334f 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -45,9 +45,13 @@ subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units ! Local variables + real :: bay_depth ! Depth of shelf, as fraction of basin depth [nondim] + real :: l1, l2 ! Fractional horizontal positions where the slope changes [nondim] + real :: x ! Fractional horizontal positions [nondim] + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] integer :: i, j - real :: x, bay_depth, l1, l2 - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay ! This include declares and sets the variable "version". # include "version_variable.h" @@ -106,28 +110,30 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju real :: e0(SZK_(GV)) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units [Z ~> m]. - integer :: i, j, k, is, ie, js, je, nz - real :: x - real :: min_thickness - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + ! positive upward, in depth units [Z ~> m] + real :: x ! Fractional horizontal positions [nondim] + real :: min_thickness ! Minimum layer thicknesses [Z ~> m] + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] character(len=40) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & default=1.e-3, units="m", do_not_log=.true., scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & - default=0.1, do_not_log=.true.) + units="nondim", default=0.1, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & - default=0.3, do_not_log=.true.) + units="nondim", default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & - default=0.2, do_not_log=.true.) + units="nondim", default=0.2, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -229,28 +235,30 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. - integer :: i, j, k, is, ie, js, je, nz - real :: x - integer :: index_bay_z - real :: delta_S - real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer - real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical - real :: xi0, xi1 + real :: x ! Fractional horizontal positions [nondim] + real :: delta_S ! Change in salinity between layers [S ~> ppt] + real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer + real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical + real :: xi0, xi1 ! Fractional vertical positions [nondim] + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] character(len=40) :: verticalCoordinate - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + integer :: index_bay_z + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & - default=0.1, do_not_log=.true.) + units="nondim", default=0.1, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & - default=0.3, do_not_log=.true.) + units="nondim", default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & - default=0.2, do_not_log=.true.) + units="nondim", default=0.2, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_RANGE", S_range,' Initial salinity range', & @@ -370,10 +378,16 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: d_eta(SZK_(GV)) ! The layer thickness in a column [Z ~> m]. - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale ! Sponge timescales [T ~> s] - real :: dome2d_west_sponge_width, dome2d_east_sponge_width - real :: dummy1, x, z + real :: dome2d_west_sponge_width ! The fraction of the domain in which the western sponge for + ! restoring T/S is active [nondim] + real :: dome2d_east_sponge_width ! The fraction of the domain in which the eastern sponge for + ! restoring T/S is active [nondim] + real :: dummy1, x ! Nondimensional local variables indicating horizontal positions [nondim] + real :: z ! Vertical positions [Z ~> m] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -405,15 +419,15 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A "DOME2d_initialize_sponges called with an associated ALE-sponge control structure.") call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & - default=0.1, do_not_log=.true.) + units="nondim", default=0.1, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & - default=0.3, do_not_log=.true.) + units="nondim", default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & - default=0.2, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, scale=US%ppt_to_S) - call get_param(param_file, mdl, "T_REF", T_ref, scale=US%degC_to_C, fail_if_missing=.false.) - call get_param(param_file, mdl, "S_RANGE", S_range, default=2.0, scale=US%ppt_to_S) - call get_param(param_file, mdl, "T_RANGE", T_range, default=0.0, scale=US%degC_to_C) + units="nondim", default=0.2, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, units="ppt", default=35.0, scale=US%ppt_to_S) + call get_param(param_file, mdl, "T_REF", T_ref, units="degC", scale=US%degC_to_C, fail_if_missing=.false.) + call get_param(param_file, mdl, "S_RANGE", S_range, units="ppt", default=2.0, scale=US%ppt_to_S) + call get_param(param_file, mdl, "T_RANGE", T_range, units="degC", default=0.0, scale=US%degC_to_C) ! Set the sponge damping rate as a function of position diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index aaededaa8c..ac586a02f6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -478,22 +478,22 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, call get_param(PF, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) - call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, "Nudging time scale for sponge layers (days)", & - default=0.0, scale=86400.0*US%s_to_T) + call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, "Nudging time scale for sponge layers", & + units="days", default=0.0, scale=86400.0*US%s_to_T) - call get_param(PF, mdl, "T_REF", t_ref, "Reference temperature", default=10.0, & - do_not_log=.true.) + call get_param(PF, mdl, "T_REF", t_ref, "Reference temperature", & + units="degC", default=10.0, scale=1.0, do_not_log=.true.) - call get_param(PF, mdl, "S_REF", s_ref, "Reference salinity", default=35.0, & - do_not_log=.true.) + call get_param(PF, mdl, "S_REF", s_ref, "Reference salinity", & + units="ppt", default=35.0, scale=1.0, do_not_log=.true.) call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, & "Surface salinity in sponge layer.", & - units="ppt", default=s_ref, scale=US%ppt_to_S) ! units="ppt") + units="ppt", default=s_ref, scale=US%ppt_to_S) call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, & "Bottom salinity in sponge layer.", & - units="ppt", default=s_ref, scale=US%ppt_to_S) ! units="ppt") + units="ppt", default=s_ref, scale=US%ppt_to_S) call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, & "Surface temperature in sponge layer.", & diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 595736540e..1684f88a89 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -92,11 +92,11 @@ function register_Kelvin_OBC(param_file, CS, US, OBC_Reg) endif if (CS%mode /= 0) then call get_param(param_file, mdl, "DENSITY_RANGE", CS%rho_range, & - default=2.0, do_not_log=.true., scale=US%kg_m3_to_R) + units="kg m-3", default=2.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "RHO_0", CS%rho_0, & - default=1035.0, do_not_log=.true., scale=US%kg_m3_to_R) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "MAXIMUM_DEPTH", CS%H0, & - default=1000.0, do_not_log=.true., scale=US%m_to_Z) + units="m", default=1000.0, scale=US%m_to_Z, do_not_log=.true.) endif ! Register the Kelvin open boundary. @@ -135,11 +135,11 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", coast_offset1, & - default=100.0, do_not_log=.true.) + units="km", default=100.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & - default=10.0, do_not_log=.true.) + units="km", default=10.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_ANGLE", coast_angle, & - default=11.3, do_not_log=.true.) + units="degrees", default=11.3, do_not_log=.true.) coast_angle = coast_angle * (atan(1.0)/45.) ! Convert to radians right_angle = 2 * atan(1.0) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 5b62993551..dd2e50fcae 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -128,7 +128,8 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j units="ppt", default=34., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, & units="ppt", default=2., scale=US%ppt_to_S, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units="ppt", default=35.0, scale=1.0, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & @@ -205,9 +206,19 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi !! only read parameters without changing T & S. ! Local variables + real :: xi0, xi1 ! Fractional positions within the depth range [nondim] + real :: r ! A nondimensional sharpness parameter with an exponetial profile [nondim] + real :: S_Ref ! Default salinity range parameters [ppt]. + real :: T_Ref ! Default temperature range parameters [degC]. + real :: S_Light, S_Dense, S_surf, S_range ! Salinity range parameters [S ~> ppt]. + real :: T_Light, T_Dense, T_surf, T_range ! Temperature range parameters [C ~> degC]. + real :: res_rat ! The ratio of density space resolution in the denser part + ! of the range to that in the lighter part of the range. + ! Setting this greater than 1 increases the resolution for + ! the denser water [nondim]. + real :: a1, frac_dense, k_frac ! Nondimensional temporary variables [nondim] integer :: i, j, k, is, ie, js, je, nz, k_light - real :: xi0, xi1, r, S_surf, T_surf, S_range, T_range - real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat + character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -233,17 +244,20 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER ) ! Initial thicknesses for layer isopycnal coordinates ! These parameters are used in MOM_fixed_initialization.F90 when CONFIG_COORD="ts_range" - call get_param(param_file, mdl, "T_REF", T_ref, default=10.0, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, & + units="degC", default=10.0, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_light, & - default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) + units="degC", default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_dense, & - default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + units="degC", default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units="1e-3", default=35.0, scale=1.0, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - default = S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="1e-3", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - default = S_Ref, scale=US%ppt_to_S, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, default=1.0, do_not_log=.true.) + units="1e-3", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & + units="nondim", default=1.0, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. ! Emulate the T,S used in the "ts_range" coordinate configuration code From 2fa9f3a5db02b0bc3f4fbc3a07bfea868c40dbc8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 16 Nov 2022 04:54:55 -0500 Subject: [PATCH 038/213] (*)Update remap_answer_date set in uninitialized types Updated the default values of remap_answer_date as declared during the specification of the wave_speed_CS, remapping_CS and regridding_CS to 99991231 (to use the very latest version of the algorithms) if these control structures are used without further initialization via optional arguments to their various initialization routines (wave_speed_init(), initialize_remapping() and initialize_regridding() or set_regrid_params()). In testing both via the TC tests and the MOM6-examples regression suite, all answers are bitwise identical, because every instance where these are used either does have an appropriate call to the initialization routine, or because (as is the case for remapping diagnostics) they are hard-coded to use the PLM remapping scheme, which is not impacted by this answer_date. It is conceivable, if unlikely, however, that there could be cases outside of the standard MOM6 code that are using this remapping capability without proper initialization of this flag, in which case answers could change. In addition, a comment was updated in the interp_CS_type indicating the cases that would be altered by changing the hard coded default answer_date there, but the default in that case was not changed. All answers and output are identical in the MOM6-examples and TC test suites. --- src/ALE/MOM_regridding.F90 | 2 +- src/ALE/MOM_remapping.F90 | 2 +- src/ALE/regrid_interp.F90 | 3 ++- src/diagnostics/MOM_wave_speed.F90 | 9 ++++----- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index de287af98a..27dd1ab4d5 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -120,7 +120,7 @@ module MOM_regridding !> The vintage of the order of arithmetic and expressions to use for remapping. !! Values below 20190101 recover the remapping answers from 2018. !! Higher values use more robust forms of the same remapping expressions. - integer :: remap_answer_date = 20181231 !### Change to 99991231? + integer :: remap_answer_date = 99991231 logical :: use_hybgen_unmix = .false. !< If true, use the hybgen unmixing code before remapping diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index e9d9a53612..9ebc0601d2 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -35,7 +35,7 @@ module MOM_remapping logical :: force_bounds_in_subcell = .false. !> The vintage of the expressions to use for remapping. Values below 20190101 result !! in the use of older, less accurate expressions. - integer :: answer_date = 20181231 !### Change to 99991231? + integer :: answer_date = 99991231 end type ! The following routines are visible to the outside world diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index dbe364c969..4d09daf6f3 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -32,7 +32,8 @@ module regrid_interp logical :: boundary_extrapolation !> The vintage of the expressions to use for remapping - integer :: answer_date = 20181231 !### Change to 99991231? + integer :: answer_date = 20181231 + !### Changing this to 99991231 changes answers in rho and Hycom1 configurations. !### There is no point where the value of answer_date is reset. end type interp_CS_type diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 85f27d4249..36dc884679 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -46,11 +46,10 @@ module MOM_wave_speed !! speeds [nondim] type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic !! mode structure. - integer :: remap_answer_date = 20181231 !< The vintage of the order of arithmetic and expressions to use + integer :: remap_answer_date = 99991231 !< The vintage of the order of arithmetic and expressions to use !! for remapping. Values below 20190101 recover the remapping !! answers from 2018, while higher values use more robust !! forms of the same remapping expressions. - !### Change to 99991231? type(diag_ctrl), pointer :: diag !< Diagnostics control structure end type wave_speed_CS @@ -1204,10 +1203,10 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de call log_version(mdl, version) call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction, & - better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol) - !### Uncomment this? remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date) + better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol, & + remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date) - !### The remap_answers_2018 argument is irrelevant, because remapping is hard-coded to use PLM. + ! The remap_answers_2018 argument here is irrelevant, because remapping is hard-coded to use PLM. call initialize_remapping(CS%remapping_CS, 'PLM', boundary_extrapolation=.false., & answer_date=CS%remap_answer_date) From 54316820f81ee1c9ce674289d2838ec01287cd7f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 18 Nov 2022 07:22:10 -0500 Subject: [PATCH 039/213] +Rossby_front_2d_init and BFB_init cleanup Completed the dimensional rescaling of internal variables in the Rossby_front_initialization and BFB_initialization modules, including the addition of comments describing numerous internal variables and their units. The BFB module was more extensively modified to place logging of the module name and version before the get_param calls for this module, following the MOM6 pattern, to correct spelling errors in get_param descriptions, and to use the grid mask in the grid file rather than a reexamination of the minimum depth to determine the land-mask. The internal subroutine write_BFB_log is no longer needed and has been folded into BFB_set_coord. All answers are bitwise identical, but there are minor changes in the MOM_parameter_doc files for the buoy_forced_basin test case. --- src/user/BFB_initialization.F90 | 68 +++++++----------- src/user/BFB_surface_forcing.F90 | 4 +- src/user/Rossby_front_2d_initialization.F90 | 80 ++++++++++++--------- 3 files changed, 72 insertions(+), 80 deletions(-) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 68a6b6530b..3efc908ffb 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -24,10 +24,6 @@ module BFB_initialization ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Unsafe model variable -!! \todo Remove this module variable -logical :: first_call = .true. - contains !> This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. @@ -42,17 +38,22 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - real :: drho_dt, SST_s, T_bot, rho_top, rho_bot - integer :: k, nz - character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name. + real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: SST_s, T_bot ! Temperatures at the surface and seafloor [C ~> degC] + real :: rho_top, rho_bot ! Densities at the surface and seafloor [R ~> kg m-3] + integer :: k, nz + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "BFB_initialization" ! This module's name. + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DRHO_DT", drho_dt, & "Rate of change of density with temperature.", & - units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R) + units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC) call get_param(param_file, mdl, "SST_S", SST_s, & - "SST at the suothern edge of the domain.", units="C", default=20.0) + "SST at the southern edge of the domain.", units="degC", default=20.0, scale=US%degC_to_C) call get_param(param_file, mdl, "T_BOT", T_bot, & - "Bottom Temp", units="C", default=5.0) + "Bottom temperature", units="degC", default=5.0, scale=US%degC_to_C) rho_top = GV%Rho0 + drho_dt*SST_s rho_bot = GV%Rho0 + drho_dt*T_bot nz = GV%ke @@ -64,15 +65,11 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) else g_prime(k) = GV%g_Earth endif - !Rlay(:) = 0.0 - !g_prime(:) = 0.0 enddo - if (first_call) call write_BFB_log(param_file) - end subroutine BFB_set_coord -!> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs +!> This subroutine sets up the sponges for the southern boundary of the domain. Maximum damping occurs !! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, depth_tot, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -92,29 +89,27 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, in depth units [Z ~> m]. real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: H0(SZK_(GV)) ! Resting layer thicknesses in depth units [Z ~> m]. - real :: min_depth ! The minimum ocean depth in depth units [Z ~> m]. real :: slat ! The southern latitude of the domain [degrees_N] real :: wlon ! The western longitude of the domain [degrees_E] real :: lenlat ! The latitudinal length of the domain [degrees_N] real :: lenlon ! The longitudinal length of the domain [degrees_E] real :: nlat ! The northern latitude of the domain [degrees_N] real :: max_damping ! The maximum damping rate [T-1 ~> s-1] + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 - ! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 ! wherever there is no sponge, and the subroutines that are called ! will automatically set up the sponges only where Idamp is positive ! and mask2dT is 1. -! Set up sponges for DOME configuration - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) + ! Set up sponges for this configuration + ! call log_version(param_file, mdl, version) slat = G%south_lat lenlat = G%len_lat @@ -124,12 +119,14 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo + ! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo max_damping = 1.0 / (86400.0*US%s_to_T) + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 + do j=js,je ; do i=is,ie - if (depth_tot(i,j) <= min_depth) then ; Idamp(i,j) = 0.0 + if (G%mask2dT(i,j) <= 0.0) then ; Idamp(i,j) = 0.0 elseif (G%geoLatT(i,j) < slat+2.0) then ; Idamp(i,j) = max_damping elseif (G%geoLatT(i,j) < slat+4.0) then Idamp(i,j) = max_damping * (slat+4.0-G%geoLatT(i,j))/2.0 @@ -140,16 +137,16 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept ! depth space for Boussinesq or non-Boussinesq models. ! This section is used for uniform thickness initialization - do k = 1,nz; eta(i,j,k) = H0(k); enddo + do k=1,nz ; eta(i,j,k) = H0(k) ; enddo - ! The below section is used for meridional temperature profile thickness initiation - ! do k = 1,nz; eta(i,j,k) = H0(k); enddo + ! The below section is used for meridional temperature profile thickness initialization + ! do k=1,nz ; eta(i,j,k) = H0(k) ; enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz ! eta(i,j,k) = -G%Angstrom_Z*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then - ! do k = 1,nz + ! do k=1,nz ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_Z)/20.0, & ! -(k-1)*G%Angstrom_Z) ! enddo @@ -166,23 +163,6 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept ! By default, momentum is advected vertically within the sponge, but ! ! momentum is typically not damped within the sponge. ! - if (first_call) call write_BFB_log(param_file) - end subroutine BFB_initialize_sponges_southonly -!> Write output about the parameter values being used. -subroutine write_BFB_log(param_file) - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. - -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "BFB_initialization" ! This module's name. - - call log_version(param_file, mdl, version) - first_call = .false. - -end subroutine write_BFB_log - end module BFB_initialization diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 6f16bdd6f0..38361ab070 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -212,10 +212,10 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) units="degrees", default=40.0) call get_param(param_file, mdl, "SST_S", CS%SST_s, & "SST at the southern edge of the linear forcing ramp.", & - units="C", default=20.0, scale=US%degC_to_C) + units="degC", default=20.0, scale=US%degC_to_C) call get_param(param_file, mdl, "SST_N", CS%SST_n, & "SST at the northern edge of the linear forcing ramp.", & - units="C", default=10.0, scale=US%degC_to_C) + units="degC", default=10.0, scale=US%degC_to_C) call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, & "The rate of change of density with temperature.", & units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC) diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 2d0dcb85e5..d3d1ad2368 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -47,9 +47,13 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read !! parameters without changing h. integer :: i, j, k, is, ie, js, je, nz - real :: Tz, Dml, eta, stretch, h0 - real :: min_thickness, T_range - real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + real :: Tz ! Vertical temperature gradient [C Z-1 ~> degC m-1] + real :: Dml ! Mixed layer depth [Z ~> m] + real :: eta ! An interface height depth [Z ~> m] + real :: stretch ! A nondimensional stretching factor [nondim] + real :: h0 ! The stretched thickness per layer [Z ~> m] + real :: T_range ! Range of temperatures over the vertical [C ~> degC] + real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -59,13 +63,12 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read if (.not.just_read) call log_version(param_file, mdl, version, "") ! Read parameters needed to set thickness - call get_param(param_file, mdl, "MIN_THICKNESS", min_thickness, & - 'Minimum layer thickness',units='m',default=1.e-3, do_not_log=just_read) call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - units='C', default=0.0, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, scale=US%kg_m3_to_R, do_not_log=.true.) + units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, & + units="kg m-3 degC-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -76,7 +79,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read case (REGRIDDING_LAYER, REGRIDDING_RHO) do j = G%jsc,G%jec ; do i = G%isc,G%iec Dml = Hml( G, G%geoLatT(i,j) ) - eta = -( -dRho_DT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) + eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz @@ -87,7 +90,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read case (REGRIDDING_ZSTAR, REGRIDDING_SIGMA) do j = G%jsc,G%jec ; do i = G%isc,G%iec Dml = Hml( G, G%geoLatT(i,j) ) - eta = -( -dRho_DT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) + eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz @@ -118,15 +121,18 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & !! only read parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz - real :: T_ref, S_ref ! Reference salinity and temerature within surface layer - real :: T_range ! Range of salinities and temperatures over the vertical - real :: zc, zi, dTdz + real :: T_ref ! Reference temperature within the surface layer [C ~> degC] + real :: S_ref ! Reference salinity within the surface layer [S ~> [ppt] + real :: T_range ! Range of temperatures over the vertical [C ~> degC] + real :: zc ! Position of the middle of the cell [Z ~> m] + real :: zi ! Bottom interface position relative to the sea surface [H ~> m or kg m-2] + real :: dTdz ! Vertical temperature gradient [C Z-1 ~> degC m-1] character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & @@ -169,12 +175,13 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just logical, intent(in) :: just_read !< If present and true, this call will only !! read parameters without setting u & v. - real :: T_range ! Range of salinities and temperatures over the vertical - real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 degC-1 ~> m s-1 degC-1] - real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - real :: Dml, zi, zc, zm ! Depths [Z ~> m]. + real :: T_range ! Range of temperatures over the vertical [C ~> degC] + real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 C-1 ~> m s-1 degC-1] + real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: Dml ! Mixed layer depth [Z ~> m] + real :: zi, zc, zm ! Depths [Z ~> m]. real :: f ! The local Coriolis parameter [T-1 ~> s-1] - real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] + real :: Ty ! The meridional temperature gradient [C L-1 ~> degC m-1] real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz character(len=40) :: verticalCoordinate @@ -184,8 +191,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - units='C', default=0.0, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, scale=US%kg_m3_to_R, do_not_log=.true.) + units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, & + units='kg m-3 degC-1', default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -197,7 +205,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just dUdT = 0.0 ; if (abs(f) > 0.0) & dUdT = ( GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) - Ty = US%L_to_m*dTdy( G, T_range, G%geoLatT(i,j) ) + Ty = dTdy( G, T_range, G%geoLatT(i,j), US ) zi = 0. do k = 1, nz hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z @@ -212,12 +220,12 @@ end subroutine Rossby_front_initialize_velocity !> Pseudo coordinate across domain used by Hml() and dTdy() !! returns a coordinate from -PI/2 .. PI/2 squashed towards the -!! center of the domain. +!! center of the domain [radians]. real function yPseudo( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, intent(in) :: lat !< Latitude + real, intent(in) :: lat !< Latitude in arbitrary units, often [km] ! Local - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] PI = 4.0 * atan(1.0) yPseudo = ( ( lat - G%south_lat ) / G%len_lat ) - 0.5 ! -1/2 .. 1/.2 @@ -226,12 +234,12 @@ end function yPseudo !> Analytic prescription of mixed layer depth in 2d Rossby front test, -!! in the same units as G%max_depth +!! in the same units as G%max_depth (usually [Z ~> m]) real function Hml( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, intent(in) :: lat !< Latitude + real, intent(in) :: lat !< Latitude in arbitrary units, often [km] ! Local - real :: dHML, HMLmean + real :: dHML, HMLmean ! The range and mean of the mixed layer depths [Z ~> m] dHML = 0.5 * ( HMLmax - HMLmin ) * G%max_depth HMLmean = 0.5 * ( HMLmin + HMLmax ) * G%max_depth @@ -239,18 +247,22 @@ real function Hml( G, lat ) end function Hml -!> Analytic prescription of mixed layer temperature gradient in 2d Rossby front test -real function dTdy( G, dT, lat ) +!> Analytic prescription of mixed layer temperature gradient in [C L-1 ~> degC m-1] in 2d Rossby front test +real function dTdy( G, dT, lat, US ) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, intent(in) :: dT !< Top to bottom temperature difference - real, intent(in) :: lat !< Latitude + real, intent(in) :: dT !< Top to bottom temperature difference [C ~> degC] + real, intent(in) :: lat !< Latitude in [km] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local - real :: PI, dHML, dHdy - real :: km = 1.e3 ! AXIS_UNITS = 'k' (1000 m) + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: dHML ! The range of the mixed layer depths [Z ~> m] + real :: dHdy ! The mixed layer depth gradient [Z L-1 ~> m m-1] + real :: km_to_L ! Horizontal axis unit conversion factor when AXIS_UNITS = 'k' (1000 m) [L km-1] PI = 4.0 * atan(1.0) + km_to_L = 1.0e3*US%m_to_L dHML = 0.5 * ( HMLmax - HMLmin ) * G%max_depth - dHdy = dHML * ( PI / ( frontFractionalWidth * G%len_lat * km ) ) * cos( yPseudo(G, lat) ) + dHdy = dHML * ( PI / ( frontFractionalWidth * G%len_lat * km_to_L ) ) * cos( yPseudo(G, lat) ) dTdy = -( dT / G%max_depth ) * dHdy end function dTdy From 798ba7a1750476c4747c0197897f97d6191fe37e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 25 Nov 2022 14:09:15 -0500 Subject: [PATCH 040/213] GitLab: Fix nolib build directories The Gaea GitLab test configuration includes two no-library compilation tests for ocean-only and ice-ocean configurations. They are currently configured to run in the same directory. Recently, several unusual I/O errors suggest problems due to concurrent testing of the builds. In order to rule out this possibility, this patch moves the ice-ocean test to a separate directory. --- .gitlab/pipeline-ci-tool.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh index e23d64523d..8334bd3950 100755 --- a/.gitlab/pipeline-ci-tool.sh +++ b/.gitlab/pipeline-ci-tool.sh @@ -151,8 +151,8 @@ nolibs-ocean-ice-compile () { section-start nolibs-ocean-ice-compile-$1 "Compiling ocean-ice $1 executable" if [ ! $DRYRUN ] ; then cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR - mkdir -p build-ocean-only-nolibs-$1 - cd build-ocean-only-nolibs-$1 + mkdir -p build-ocean-ice-nolibs-$1 + cd build-ocean-ice-nolibs-$1 make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. -s ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} sed -i '/FMS1\/.*\/test_/d' path_names From 7055b7cf2c46f2e30c9e13e9d0d7fadfe7235a8d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 23 Nov 2022 08:22:48 -0500 Subject: [PATCH 041/213] Document units in 9 vertical param modules Documented numerous internal variables and their units in 9 vertical parameterization modules (MOM_bkgnd_mixing, MOM_bulk_mixed_layer, MOM_diabatic_aux, MOM_diabatic_driver, MOM_entrain_diffusive, MOM_kappa_shear, MOM_regularize_layers, MOM_set_diffusivity and MOM_set_viscosity). This commit includes the addition of units arguments in 9 unlogged get_param calls while 4 of these calls are now being scaled into the units used in MOM6 and then unscaled when used as the default for other parameters. A number of spelling errors were also corrected in comments. All answers and output are bitwise identical. --- .../vertical/MOM_bkgnd_mixing.F90 | 20 +- .../vertical/MOM_bulk_mixed_layer.F90 | 200 ++++++++++-------- .../vertical/MOM_diabatic_aux.F90 | 68 +++--- .../vertical/MOM_diabatic_driver.F90 | 67 +++--- .../vertical/MOM_entrain_diffusive.F90 | 143 +++++++------ .../vertical/MOM_kappa_shear.F90 | 85 ++++---- .../vertical/MOM_regularize_layers.F90 | 24 ++- .../vertical/MOM_set_diffusivity.F90 | 71 +++---- .../vertical/MOM_set_viscosity.F90 | 47 ++-- 9 files changed, 400 insertions(+), 325 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index ba47f281e8..5a39f83c5d 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -57,11 +57,11 @@ module MOM_bkgnd_mixing real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the - !! Henyey scaling from the mixing + !! Henyey scaling from the mixing [nondim] real :: prandtl_bkgnd !< Turbulent Prandtl number used to convert - !! vertical background diffusivity into viscosity + !! vertical background diffusivity into viscosity [nondim] real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of - !! diffusivities with Kd_tanh_lat_fn. Valid values + !! diffusivities with Kd_tanh_lat_fn [nondim]. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] !! when no other physically based mixed layer turbulence @@ -151,10 +151,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL CS%physical_OBL_scheme = physical_OBL_scheme if (CS%physical_OBL_scheme) then ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, default=-1., do_not_log=.true.) + call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, & + units="m2 s-1", default=-1., scale=US%m2_s_to_Z2_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KDML is a depricated parameter that should not be used.") - call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, default=-1., do_not_log=.true.) + call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & + units="m2 s-1", default=-1., scale=US%m2_s_to_Z2_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KD_ML_TOT cannot be set when using a physically based ocean "//& "boundary layer mixing parameterization.") @@ -338,8 +340,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, real :: I_2Omega !< 1/(2 Omega) [T ~> s] real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim] real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim] - real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) - real :: deg_to_rad !< factor converting degrees to radians, pi/180. + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) [nondim] + real :: deg_to_rad !< factor converting degrees to radians [radians degree-1], pi/180. real :: abs_sinlat !< absolute value of sine of latitude [nondim] real :: min_sinlat ! The minimum value of the sine of latitude [nondim] real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1] @@ -455,7 +457,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, enddo endif - ! Now set background diffusivies based on these surface values, possibly with vertical structure. + ! Now set background diffusivities based on these surface values, possibly with vertical structure. if ((.not.CS%physical_OBL_scheme) .and. (CS%Kd /= CS%Kd_tot_ml)) then ! This is a crude way to put in a diffusive boundary layer without an explicit boundary ! layer turbulence scheme. It should not be used for any realistic ocean models. @@ -527,7 +529,7 @@ subroutine check_bkgnd_scheme(CS, str) end subroutine -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory subroutine bkgnd_mixing_end(CS) type(bkgnd_mixing_cs), pointer :: CS !< Control structure for this module that !! will be deallocated in this subroutine diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 49d62bbde4..2f8e03480e 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -35,7 +35,7 @@ module MOM_bulk_mixed_layer integer :: nkbl !< The number of buffer layers. integer :: nsw !< The number of bands of penetrating shortwave radiation. real :: mstar !< The ratio of the friction velocity cubed to the - !! TKE input to the mixed layer, nondimensional. + !! TKE input to the mixed layer [nondim]. real :: nstar !< The fraction of the TKE input to the mixed layer !! available to drive entrainment [nondim]. real :: nstar2 !< The fraction of potential energy released by @@ -43,7 +43,7 @@ module MOM_bulk_mixed_layer logical :: absorb_all_SW !< If true, all shortwave radiation is absorbed by the !! ocean, instead of passing through to the bottom mud. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE - !! decay scale, nondimensional. + !! decay scale [nondim]. real :: bulk_Ri_ML !< The efficiency with which mean kinetic energy !! released by mechanically forced entrainment of !! the mixed layer is converted to TKE [nondim]. @@ -84,9 +84,9 @@ module MOM_bulk_mixed_layer integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective !! adjustment on this many layers (starting from the !! top) before sorting the remaining layers. - real :: omega_frac !< When setting the decay scale for turbulence, use - !! this fraction of the absolute rotation rate blended - !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + real :: omega_frac !< When setting the decay scale for turbulence, use this fraction + !! of the absolute rotation rate blended with the local value of f, + !! as sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. logical :: correct_absorption !< If true, the depth at which penetrating !! shortwave radiation is absorbed is corrected by !! moving some of the heating upward in the water @@ -105,9 +105,8 @@ module MOM_bulk_mixed_layer !! points of the surface region (mixed & buffer !! layer) thickness [nondim]. 0.5 by default. real :: lim_det_dH_bathy !< The fraction of the total depth by which the - !! thickness of the surface region (mixed & buffer - !! layer) is allowed to change between grid points. - !! Nondimensional, 0.2 by default. + !! thickness of the surface region (mixed & buffer layers) is allowed + !! to change between grid points [nondim]. 0.2 by default. logical :: use_river_heat_content !< If true, use the fluxes%runoff_Hflx field !! to set the heat carried by runoff, instead of !! using SST for temperature of liq_runoff @@ -118,21 +117,21 @@ module MOM_bulk_mixed_layer type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. real :: Allowed_T_chg !< The amount by which temperature is allowed - !! to exceed previous values during detrainment, K. + !! to exceed previous values during detrainment [C ~> degC] real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment [S ~> ppt] ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. - diag_TKE_wind, & !< The wind source of TKE. - diag_TKE_RiBulk, & !< The resolved KE source of TKE. - diag_TKE_conv, & !< The convective source of TKE. - diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating. - diag_TKE_mech_decay, & !< The decay of mechanical TKE. - diag_TKE_conv_decay, & !< The decay of convective TKE. - diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. - diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. + diag_TKE_wind, & !< The wind source of TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_RiBulk, & !< The resolved KE source of TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_conv, & !< The convective source of TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating [Z L2 T-3 ~> m3 s-3]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_conv_decay, & !< The decay of convective TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [Z L2 T-3 ~> m3 s-3]. + diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2 [Z L2 T-3 ~> m3 s-3]. diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer !! detrainment [R Z L2 T-3 ~> W m-2]. diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only @@ -171,10 +170,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent - !! fields have NULL ptrs. + !! fields have NULL pointers. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a @@ -184,7 +183,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C intent(inout) :: eb !< The amount of fluid moved upward into a !! layer; this should be increased due to !! mixed layer entrainment [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure type(optics_type), pointer :: optics !< The structure that can be queried for the !! inverse of the vertical absorption decay !! scale for penetrating shortwave radiation. @@ -195,7 +194,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! being applied separately. real, optional, intent(in) :: dt_diag !< The diagnostic time step, !! which may be less than dt if there are - !! two callse to mixedlayer [T ~> s]. + !! two calls to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< if true, this is the last call !! to mixedlayer in the current time step, so !! diagnostics will be written. The default is @@ -247,8 +246,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! entrained [C H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained ! [H S ~> m ppt or ppt kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + uhtot, & ! The depth integrated zonal velocity in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] + vhtot, & ! The depth integrated meridional velocity in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the @@ -278,7 +277,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated ! over a time step in each band [C H ~> degC m or degC kg m-2]. real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: & - opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indicies are band, i, k. + opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indices are band, i, k. real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the ! denominator of MKE_rate; the two elements have differing @@ -318,7 +317,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. real :: kU_star ! Ustar times the Von Karman constant [Z T-1 ~> m s-1]. - real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. + real :: dt__diag ! A rescaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -585,9 +584,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C enddo ; endif endif -! Move water left in the former mixed layer into the buffer layer and -! from the buffer layer into the interior. These steps might best be -! treated in conjuction. + ! Move water left in the former mixed layer into the buffer layer and + ! from the buffer layer into the interior. These steps might best be + ! treated in conjunction. if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & @@ -777,7 +776,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment !! (perhaps CS%nkml). @@ -952,13 +951,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent - !! fields have NULL ptrs. + !! fields have NULL pointers. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are @@ -1261,7 +1260,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! adjustment [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields - !! have NULL ptrs. + !! have NULL pointers. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in @@ -1290,8 +1289,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! time interval [T-1 ~> s-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. @@ -1500,14 +1499,14 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure ! This subroutine calculates mechanically driven entrainment. ! Local variables real :: SW_trans ! The fraction of shortwave radiation that is not - ! absorbed in a layer, nondimensional. + ! absorbed in a layer [nondim]. real :: Pen_absorbed ! The amount of penetrative shortwave radiation ! that is absorbed in a layer [C H ~> degC m or degC kg m-2]. real :: h_avail ! The thickness in a layer available for entrainment [H ~> m or kg m-2]. @@ -1517,7 +1516,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: MKE_rate ! The fraction of the energy in resolved shears ! within the mixed layer that will be eliminated - ! within a timestep, nondim, 0 to 1. + ! within a timestep [nondim], 0 to 1. real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, @@ -1541,17 +1540,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dEF4_dh ! The partial derivative of EF4 with h [H-2 ~> m-2 or m4 kg-2]. - real :: Pen_En1 ! A nondimensional temporary variable. - real :: kh, exp_kh ! Nondimensional temporary variables related to the - real :: f1_kh ! fractional decay of TKE across a layer. - real :: x1, e_x1 ! Nondimensional temporary variables related to - real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across - real :: f3_x1 ! a layer, and exponential-related functions of x1. + real :: Pen_En1 ! A nondimensional temporary variable [nondim]. + real :: kh, exp_kh, f1_kh ! Nondimensional temporary variables related to the + ! fractional decay of TKE across a layer [nondim]. + real :: x1, e_x1 ! Nondimensional temporary variables related to the relative decay + ! of TKE and SW radiation across a layer [nondim] + real :: f1_x1, f2_x1, f3_x1 ! Exponential-related functions of x1 [nondim]. real :: E_HxHpE ! Entrainment divided by the product of the new and old ! thicknesses [H-1 ~> m-1 or m2 kg-1]. real :: Hmix_min ! The minimum mixed layer depth [H ~> m or kg m-2]. - real :: opacity - real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. + real :: opacity ! The opacity of a layer in a band of shortwave radiation [H-1 ~> m-1 or m2 kg-1] + real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. [nondim] integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 @@ -1784,12 +1783,12 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) !! the layers [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. ! Local variables - real :: R0sort(SZI_(G),SZK_(GV)) - integer :: nsort(SZI_(G)) + real :: R0sort(SZI_(G),SZK_(GV)) ! The sorted potential density [R ~> kg m-3] + integer :: nsort(SZI_(G)) ! The number of layers left to sort logical :: done_sorting(SZI_(G)) integer :: i, k, ks, is, ie, nz, nkmb @@ -1852,14 +1851,14 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! layer in the entrainment from !! below [H ~> m or kg m-2]. Positive values go !! with mass gain by a layer. - integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of - !! cpotential density referenced + !! potential density referenced !! to the surface with salinity, !! [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -1880,21 +1879,38 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS ! and the coordinate density (sigma-2)) between the newly forming mixed layer ! and a residual buffer- or mixed layer, and the number of massive layers above ! the deepest massive buffer or mixed layer is greater than nkbl, then split -! those buffer layers into peices that match the target density of the two +! those buffer layers into pieces that match the target density of the two ! nearest interior layers. ! Otherwise, if there are more than nkbl+1 remaining massive layers ! Local variables - real :: h_move, h_tgt_old, I_hnew - real :: dT_dS_wt2, dT_dR, dS_dR, I_denom - real :: Rcv_int - real :: T_up, S_up, R0_up, I_hup, h_to_up - real :: T_dn, S_dn, R0_dn, I_hdn, h_to_dn - real :: wt_dn - real :: dR1, dR2 - real :: dPE, hmin, min_dPE, min_hmin - real, dimension(SZK_(GV)) :: & - h_tmp, R0_tmp, T_tmp, S_tmp, Rcv_tmp + real :: h_move ! The thickness of water being moved between layers [H ~> m or kg m-2] + real :: h_tgt_old ! The previous thickness of the recipient layer [H ~> m or kg m-2] + real :: I_hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m3 kg-1] + real :: dT_dS_wt2 ! The square of the relative weighting of temperature and salinity changes + ! when extraploating to match a target density [C2 S-2 ~> degC2 ppt-2] + real :: dT_dR ! The ratio of temperature changes to density changes when + ! extrapolating [C R-1 ~> degC m3 kg-1] + real :: dS_dR ! The ratio of salinity changes to density changes when + ! extrapolating [S R-1 ~> ppt m3 kg-1] + real :: I_denom ! A work variable with units of [S2 R-2 ~> ppt2 m6 kg-2]. + real :: Rcv_int ! The target coordinate density of an interior layer [R ~> kg m-3] + real :: T_up, T_dn ! Temperatures projected to match the target densities of two layers [C ~> degC] + real :: S_up, S_dn ! Salinities projected to match the target densities of two layers [S ~> ppt] + real :: R0_up, R0_dn ! Potential densities projected to match the target coordinate + ! densities of two layers [R ~> kg m-3] + real :: I_hup, I_hdn ! Inverse of the new thicknesses of the two layers [H-1 ~> m-1 or m2 kg-1] + real :: h_to_up, h_to_dn ! Thickness transferred to two layers [H ~> m or kg m-2] + real :: wt_dn ! Fraction of the thickness transferred to the deeper layer [nondim] + real :: dR1, dR2 ! Density difference with the target densities of two layers [R ~> kg m-3] + real :: dPE, min_dPE ! Values proportional to the potential energy change due to the merging + ! of a pair of layers [R H2 ~> kg m-1 or kg3 m-6] + real :: hmin, min_hmin ! The thickness of the thinnest layer [H ~> m or kg m-2] + real :: h_tmp(SZK_(GV)) ! A copy of the original layer thicknesses [H ~> m or kg m-2] + real :: R0_tmp(SZK_(GV)) ! A copy of the original layer potential densities [R ~> kg m-3] + real :: T_tmp(SZK_(GV)) ! A copy of the original layer temperatures [C ~> degC] + real :: S_tmp(SZK_(GV)) ! A copy of the original layer salinities [S ~> ppt] + real :: Rcv_tmp(SZK_(GV)) ! A copy of the original layer coordinate densities [R ~> kg m-3] integer :: ks_min logical :: sorted, leave_in_layer integer :: ks_deep(SZI_(G)), k_count(SZI_(G)), ks2_reverse(SZI_(G), SZK_(GV)) @@ -2168,13 +2184,13 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, !! [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of - !! cpotential density referenced to the + !! potential density referenced to the !! surface with salinity !! [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -2224,10 +2240,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: stays_min_merge ! The minimum allowed value of stays_merge [H ~> m or kg m-2]. real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0 and Rcv [R H-1 ~> kg m-4 or m-1] -! real :: dT_2dz, dS_2dz ! Half the vertical gradients of T and S, in degC H-1, and ppt H-1. +! real :: dT_2dz ! Half the vertical gradient of T [C H-1 ~> degC m-1 or degC m2 kg-1] +! real :: dS_2dz ! Half the vertical gradient of S [S H-1 ~> ppt m-1 or ppt m2 kg-1] real :: scale_slope ! A nondimensional number < 1 used to scale down ! the slope within the upper buffer layer when - ! water MUST be detrained to the lower layer. + ! water MUST be detrained to the lower layer [nondim]. real :: dPE_extrap ! The potential energy change due to dispersive ! advection or mixing layers, divided by @@ -2264,9 +2281,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dPE_ratio ! Multiplier of dPE_det at which merging is ! permitted - here (detrainment_per_day/dt)*30 - ! days? + ! days? [nondim] real :: num_events ! The number of detrainment events over which - ! to prefer merging the buffer layers. + ! to prefer merging the buffer layers [nondim]. real :: dPE_time_ratio ! Larger of 1 and the detrainment timescale over dt [nondim]. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in @@ -2287,14 +2304,16 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables [nondim] - real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables, - real :: Ihk0, Ihk1, Ih12 ! all in [H-1 ~> m-1 or m2 kg-1]. - real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, - real :: dR0, dR21, dRcv ! all in [R ~> kg m-3]. + real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables [H-1 ~> m-1 or m2 kg-1] + real :: Ihk0, Ihk1, Ih12 ! Assorted inverse thickness work variables [H-1 ~> m-1 or m2 kg-1] + real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables [R ~> kg m-3] + real :: dR0, dR21, dRcv ! Assorted density difference work variables [R ~> kg m-3] real :: dRcv_stays, dRcv_det, dRcv_lim ! Assorted densities [R ~> kg m-3] - real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. + real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. - real :: h2_to_k1_lim, T_new, S_new, T_max, T_min, S_max, S_min + real :: h2_to_k1_lim ! A limit on the thickness that can be detrained to layer k1 [H ~> m or kg m-2] + real :: T_new, T_max, T_min ! Temperature of the detrained water and limits on it [C ~> degC] + real :: S_new, S_max, S_min ! Salinity of the detrained water and limits on it [S ~> ppt] integer :: i, k, k0, k1, is, ie, nz, kb1, kb2, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke @@ -2352,7 +2371,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! (3) The lower buffer layer density extrapolated to its base with a ! linear fit between the two layers must exceed the density of the ! next denser interior layer. - ! (4) The average extroplated coordinate density that is moved into the + ! (4) The average extrapolated coordinate density that is moved into the ! isopycnal interior matches the target value for that layer. ! (5) The potential energy change is calculated and might be used later ! to allow the upper buffer layer to mix more into the lower buffer @@ -3062,7 +3081,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! a layer. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature @@ -3081,9 +3100,17 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. - real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 + real :: dT_dS_wt2 ! The square of the relative weighting of temperature and salinity changes + ! when extraploating to match a target density [C2 S-2 ~> degC2 ppt-2] + real :: dT_dR ! The ratio of temperature changes to density changes when + ! extrapolating [C R-1 ~> degC m3 kg-1] + real :: dS_dR ! The ratio of salinity changes to density changes when + ! extrapolating [S R-1 ~> ppt m3 kg-1] + real :: dRml ! The density range within the extent of the mixed layers [R ~> kg m-3] + real :: dR0_dRcv ! The relative changes in the potential density and the coordinate density [nondim] real :: I_denom ! A work variable [S2 R-2 ~> ppt2 m6 kg-2]. - real :: Sdown, Tdown ! A salinity [S ~> ppt] and a temperature [C ~> degC] + real :: Sdown ! The salinity of the detrained water [S ~> ppt] + real :: Tdown ! The temperature of the detrained water [C ~> degC] real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time @@ -3091,11 +3118,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: g_H2_2dt ! Half the gravitational acceleration times the square of the ! conversion from H to Z divided by the diagnostic time step ! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. - + real :: x1 ! A temporary work variable [various] logical :: splittable_BL(SZI_(G)), orthogonal_extrap - real :: x1 - integer :: i, is, ie, k, k1, nkmb, nz + is = G%isc ; ie = G%iec ; nz = GV%ke nkmb = CS%nkml+CS%nkbl if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & @@ -3329,13 +3355,15 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] - real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m + real :: omega_frac_dflt ! The default value for ML_OMEGA_FRAC [nondim] + real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [m s-1] + real :: Hmix_min_m ! The unscaled value of HMIX_MIN [m] integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3600,7 +3628,7 @@ function EF4(Ht, En, I_L, dR_de) real :: EF4 !< The integral [H-1 ~> m-1 or m2 kg-1]. ! Local variables - real :: exp_LHpE ! A nondimensional exponential decay. + real :: exp_LHpE ! A nondimensional exponential decay [nondim]. real :: I_HpE ! An inverse thickness plus entrainment [H-1 ~> m-1 or m2 kg-1]. real :: Res ! The result of the integral above [H-1 ~> m-1 or m2 kg-1]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index a3450bd6e4..d51f796df1 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -242,20 +242,19 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) ! local variables real, dimension(SZI_(G)) :: & - b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. - d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim]. + b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. + d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim]. real, dimension(SZI_(G),SZK_(GV)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. + c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2]. - real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness [H ~> m or kg m-2]. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_h_int ! The inverse of the thickness associated with an - ! interface [H-1 ~> m-1 or m2 kg-1]. - real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. + mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2]. + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness [H ~> m or kg m-2]. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: I_h_int ! The inverse of the thickness associated with an interface [H-1 ~> m-1 or m2 kg-1]. + real :: b_denom_T ! The first term in the denominator for the expression for b1_T [H ~> m or kg m-2]. + real :: b_denom_S ! The first term in the denominator for the expression for b1_S [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -497,17 +496,18 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) !! v_h as though ea and eb were being supplied with !! uniformly zero values. - ! local variables + ! Local variables real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: b1(SZI_(G)) ! A thickness used in the tridiagonal solver [H ~> m or kg m-2] real :: c1(SZI_(G),SZK_(GV)) ! A variable used in the tridiagonal solver [nondim] real :: d1(SZI_(G)) ! The complement of c1 [nondim] - real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring - real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open - ! ocean, nondimensional. - real :: sum_area, Idenom + ! Fractional weights of the neighboring velocity points, ~1/2 in the open ocean. + real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring velocity points [nondim] + real :: a_e(SZI_(G)), a_w(SZI_(G)) ! Fractional weights of the neighboring velocity points [nondim] + real :: sum_area ! A sum of adjacent areas [L2 ~> m2] + real :: Idenom ! The inverse of the denomninator in a weighted average [L-2 ~> m-2] logical :: mix_vertically, zero_mixing integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -527,6 +527,12 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) do i=is,ie sum_area = G%areaCu(I-1,j) + G%areaCu(I,j) if (sum_area > 0.0) then + ! If this were a simple area weighted average, this would just be I_denom = 1.0 / sum_area. + ! The other factor of sqrt(0.5*sum_area*G%IareaT(i,j)) is 1 for open ocean points on a + ! Cartesian grid. This construct predates the initial commit of the MOM6 code, and was + ! present in the GOLD code before February, 2010. I do not recall why this was added, and + ! the GOLD CVS server that contained the relevant history and logs appears to have been + ! decommissioned. Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) a_w(i) = G%areaCu(I-1,j) * Idenom a_e(i) = G%areaCu(I,j) * Idenom @@ -803,7 +809,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) ! converges extremely quickly (usually 1 guess) since this equation turns out to be rather ! linear for PE change with increasing X. ! Input parameters: - integer, dimension(3), intent(in) :: id_MLD !< Energy output diag IDs + integer, dimension(3), intent(in) :: id_MLD !< Energy output diagnostic IDs type(ocean_grid_type), intent(in) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1045,13 +1051,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Local variables integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) - real :: H_limit_fluxes - real :: IforcingDepthScale + real :: H_limit_fluxes ! Surface fluxes are scaled down fluxes when the total depth of the ocean + ! drops below this value [H ~> m or kg m-2] + real :: IforcingDepthScale ! The inverse of the layer thickness below which mass losses are + ! shifted to the next deeper layer [H ~> m or kg m-2] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: dThickness, dTemp, dSalt - real :: fractionOfForcing, hOld, Ithickness + real :: dThickness ! The change in layer thickness [H ~> m or kg m-2] + real :: dTemp ! The integrated change in layer temperature [C H ~> degC m or degC kg m-2] + real :: dSalt ! The integrated change in layer salinity [S H ~> ppt m or ppt kg m-2] + real :: fractionOfForcing ! THe fraction of the remaining forcing applied to a layer [nondim] + real :: hOld ! The original thickness of a layer [H ~> m or kg m-2] + real :: Ithickness ! The inverse of the new layer thickness [H-1 ~> m-1 or m2 kg-1] real :: RivermixConst ! A constant used in implementing river mixing [R Z2 T-1 ~> Pa s]. - real :: EnthalpyConst ! A constant used to control the enthalpy calculation + real :: EnthalpyConst ! A constant used to control the enthalpy calculation [nondim] ! By default EnthalpyConst = 1.0. If fluxes%heat_content_evap ! is associated enthalpy is provided via coupler and EnthalpyConst = 0.0. real, dimension(SZI_(G)) :: & @@ -1092,13 +1104,17 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency ! band of shortwave radiation in each layer [H-1 ~> m-1 or m2 kg-1] real, dimension(maxGroundings) :: hGrounding ! Thickness added by each grounding event [H ~> m or kg m-2] - real :: Temp_in, Salin_in + real :: Temp_in ! The initial temperature of a layer [C ~> degC] + real :: Salin_in ! The initial salinity of a layer [S ~> ppt] real :: g_Hconv2 ! A conversion factor for use in the TKE calculation ! in units of [Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. real :: GoRho ! g_Earth times a unit conversion factor divided by density ! [Z T-2 R-1 ~> m4 s-2 kg-1] - logical :: calculate_energetics - logical :: calculate_buoyancy + logical :: calculate_energetics ! If true, calculate the energy required to mix the newly added + ! water over the topmost grid cell, assuming that the fluxes of heat and salt + ! and rejected brine are initially applied in vanishingly thin layers at the + ! top of the layer before being mixed throughout the layer. + logical :: calculate_buoyancy ! If true, calculate the surface buoyancy flux. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, nb character(len=45) :: mesg diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ddafbc3274..7cfcbfab07 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -122,7 +122,7 @@ module MOM_diabatic_driver !! other diffusivities. Otherwise, the larger of kappa- !! shear and ePBL diffusivities are used. real :: ePBL_Prandtl !< The Prandtl number used by ePBL to convert vertical - !! diffusivities into viscosities. + !! diffusivities into viscosities [nondim]. integer :: nMode = 1 !< Number of baroclinic modes to consider real :: uniform_test_cg !< Uniform group velocity of internal tide !! for testing internal tides [L T-1 ~> m s-1] @@ -133,7 +133,7 @@ module MOM_diabatic_driver !! FW fluxes are applied separately or combined before !! being applied. real :: ML_mix_first !< The nondimensional fraction of the mixed layer - !! algorithm that is applied before diffusive mixing. + !! algorithm that is applied before diffusive mixing [nondim]. !! The default is 0, while 0.5 gives Strang splitting !! and 1 is a sensible value too. Note that if there !! are convective instabilities in the initial state, @@ -174,8 +174,8 @@ module MOM_diabatic_driver real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics [R Z L2 T-2 ~> J m-2] !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diag handle for mode-1 speed - integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds + integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed + integer, allocatable, dimension(:) :: id_cn ! diagnostic handle for all mode speeds integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 @@ -231,14 +231,14 @@ module MOM_diabatic_driver type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct - type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control struct - type(energetic_PBL_CS) :: ePBL !< Energetic PBL control struct - type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct - type(geothermal_CS) :: geothermal !< Geothermal control struct - type(int_tide_CS) :: int_tide !< Internal tide control struct - type(opacity_CS) :: opacity !< Opacity control struct - type(regularize_layers_CS) :: regularize_layers !< Regularize layer control struct + type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control structure + type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control structure + type(energetic_PBL_CS) :: ePBL !< Energetic PBL control structure + type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control structure + type(geothermal_CS) :: geothermal !< Geothermal control structure + type(int_tide_CS) :: int_tide !< Internal tide control structure + type(opacity_CS) :: opacity !< Opacity control structure + type(regularize_layers_CS) :: regularize_layers !< Regularize layer control structure type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -1659,9 +1659,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & ! These are targets so that the space can be shared with eaml & ebml. - eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and - ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) + eatr, & ! The equivalent of ea for tracers, which differs from ea in that it tends to + ! homogenize tracers in massless layers near the boundaries [H ~> m or kg m-2] + ebtr ! The equivalent of eb for tracers, which differs from eb in that it tends to + ! homogenize tracers in massless layers near the boundaries [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] @@ -2620,7 +2621,7 @@ subroutine adiabatic(h, tv, fluxes, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: zeros ! An array of zeros. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: zeros ! An array of zeros with units of [H ~> m or kg m-2] zeros(:,:,:) = 0.0 @@ -2646,8 +2647,8 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, type(diabatic_CS), pointer :: CS !< module control structure ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d ! A 3-d work array for diagnostics [various] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array for diagnostics [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: ppt2mks ! Conversion factor from S to kg/kg [S-1 ~> ppt-1]. integer :: i, j, k, is, ie, js, je, nz @@ -2741,8 +2742,8 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, type(diabatic_CS), pointer :: CS !< module control structure ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d ! A 3-d work array for diagnostics [various] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array for diagnostics [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: ppt2mks ! Conversion factor from S to kg/kg [S-1 ~> ppt-1]. integer :: i, j, k, is, ie, js, je, nz @@ -2828,8 +2829,8 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d ! A 3-d work array for diagnostics [various] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array for diagnostics [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz @@ -2942,10 +2943,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di !! tracer flow control module type(sponge_CS), pointer :: sponge_CSp !< pointer to the sponge module control structure type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure - type(oda_incupd_CS), pointer :: oda_incupd_CSp !< pointer to the oda incupd module control structure + type(oda_incupd_CS), pointer :: oda_incupd_CSp !< pointer to the ocean data assimilation incremental + !! update module control structure ! Local variables - real :: Kd ! A diffusivity used in the default for other tracer diffusivities, in MKS units [m2 s-1] + real :: Kd ! A diffusivity used in the default for other tracer diffusivities [Z2 T-1 ~> m2 s-1] logical :: use_temperature character(len=20) :: EN1, EN2, EN3 @@ -3082,11 +3084,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "KD_MIN_TR were operating.", default=.false., do_not_log=.not.CS%useALEalgorithm) if (CS%mix_boundary_tracers .or. CS%mix_boundary_tracer_ALE) then - call get_param(param_file, mdl, "KD", Kd, default=0.0) + call get_param(param_file, mdl, "KD", Kd, units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to "//& "tracers, especially in massless layers near the bottom. "//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m2_s_to_Z2_T) + "The default is 0.1*KD.", & + units="m2 s-1", default=0.1*Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will "//& "allow for explicitly specified bottom fluxes. The "//& @@ -3280,9 +3283,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif - ! diagnostics for tendencies of temp and saln due to diabatic processes + ! Diagnostics for tendencies of temperature and salinity due to diabatic processes, ! available only for ALE algorithm. - ! diagnostics for tendencies of temp and heat due to frazil + ! Diagnostics for tendencies of temperature and heat due to frazil CS%id_diabatic_diff_h = register_diag_field('ocean_model', 'diabatic_diff_h', diag%axesTL, Time, & 'Cell thickness used during diabatic diffusion', & thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.) @@ -3354,9 +3357,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%diabatic_diff_tendency_diag = .true. endif - ! diagnostics for tendencies of thickness temp and saln due to boundary forcing + ! Diagnostics for tendencies of thickness temperature and salinity due to boundary forcing, ! available only for ALE algorithm. - ! diagnostics for tendencies of temp and heat due to frazil + ! Diagnostics for tendencies of temperature and heat due to frazil CS%id_boundary_forcing_h = register_diag_field('ocean_model', 'boundary_forcing_h', diag%axesTL, Time, & 'Cell thickness after applying boundary forcing', & thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.) @@ -3593,8 +3596,8 @@ end subroutine diabatic_driver_end !! calculated flux of the layer above and an estimated flux in the !! layer below. This flux is subject to the following conditions: !! (1) the flux in the top and bottom layers are set by the boundary -!! conditions, and (2) no layer may be driven below an Angstrom thick- -!! ness. If there is a bulk mixed layer, the buffer layer is treated +!! conditions, and (2) no layer may be driven below a minimal thickness. +!! If there is a bulk mixed layer, the buffer layer is treated !! as a fixed density layer with vanishingly small diffusivity. !! !! diabatic takes 5 arguments: the two velocities (u and v), the diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index beb207624a..792c30cc98 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -113,7 +113,8 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & diff_work ! The work actually done by diffusion across each ! interface [R Z3 T-3 ~> W m-2]. Sum vertically for the total work. - real :: hm, fm, fr, fk ! Work variables with units of H, H, H, and H2. + real :: hm, fm, fr ! Work variables with units of [H ~> m or kg m-2]. + real :: fk ! A Work variable with units of [H2 ~> m2 or kg2 m-4] real :: b1(SZI_(G)) ! A variable used by the tridiagonal solver [H ~> m or kg m-2] real :: c1(SZI_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim] @@ -140,9 +141,11 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & zeros, & ! An array of all zeros. (Usually used with [H ~> m or kg m-2].) max_eakb, & ! The maximum value of eakb that might be realized [H ~> m or kg m-2]. min_eakb, & ! The minimum value of eakb that might be realized [H ~> m or kg m-2]. - err_max_eakb0, & ! The value of error returned by determine_Ea_kb - err_min_eakb0, & ! when eakb = min_eakb and max_eakb and ea_kbp1 = 0. - err_eakb0, & ! A value of error returned by determine_Ea_kb. + err_max_eakb0, & ! The value of error returned by determine_Ea_kb when eakb = max_eakb + ! and ea_kbp1 = 0 [H2 ~> m2 or kg2 m-4]. + err_min_eakb0, & ! The value of error returned by determine_Ea_kb when eakb = min_eakb + ! and ea_kbp1 = 0 [H2 ~> m2 or kg2 m-4]. + err_eakb0, & ! A value of error returned by determine_Ea_kb [H2 ~> m2 or kg2 m-4]. F_kb, & ! The value of F in layer kb, or equivalently the entrainment ! from below by layer kb [H ~> m or kg m-2]. dFdfm_kb, & ! The partial derivative of F with fm [nondim]. See dFdfm. @@ -187,7 +190,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! entrain from the layer above [H ~> m or kg m-2]. real :: Kd_here ! The effective diapycnal diffusivity times the timestep [H2 ~> m2 or kg2 m-4]. real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. - real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. + real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account [R ~> kg m-3]. real :: Rho_cor ! The depth-integrated potential density anomaly that ! needs to be corrected for [H R ~> kg m-2 or kg2 m-5]. real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. @@ -752,7 +755,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ea(i,j,k) = ea(i,j,k) + ea_cor eb(i,j,k) = eb(i,j,k) - (dS_kb(i) * I_dSkbp1(i)) * ea_cor elseif (k < kb(i)) then - ! Repetative, unless ea(kb) has been corrected. + ! Repetitive, unless ea(kb) has been corrected. ea(i,j,k) = ea(i,j,k+1) endif enddo @@ -761,7 +764,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ea(i,j,k) = ea(i,j,k+1) enddo ; enddo - ! Repetative, unless ea(kb) has been corrected. + ! Repetitive, unless ea(kb) has been corrected. k=kmb do i=is,ie ! Do not adjust eb through the base of the buffer layers, but it @@ -909,7 +912,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb) real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dsp1_ds !< The ratio of coordinate variable !! differences across the interfaces below !! a layer over the difference across the - !! interface above the layer. + !! interface above the layer [nondim]. real, dimension(SZI_(G)), intent(in) :: eakb !< The entrainment from above by the layer !! below the buffer layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Ent_bl !< The average entrainment upward and @@ -1232,13 +1235,14 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - b1, c1, & ! b1 and c1 are variables used by the tridiagonal solver. - S, dS_dE, & ! The coordinate density [R ~> kg m-3] and its derivative with E. - ea, dea_dE, & ! The entrainment from above and its derivative with E. - eb, deb_dE ! The entrainment from below and its derivative with E. - real :: deriv_dSkb(SZI_(G)) - real :: d1(SZI_(G)) ! d1 = 1.0-c1 is also used by the tridiagonal solver. - real :: src ! A source term for dS_dR. + b1, c1, & ! b1 [H-1 ~> m-1 or m2 kg-1] and c1 [nondim] are variables used by the tridiagonal solver. + S, dS_dE, & ! The coordinate density [R ~> kg m-3] and its derivative with E [R H-1 ~> kg m-4 or m-1]. + ea, dea_dE, & ! The entrainment from above [H ~> m or kg m-2] and its derivative with E [nondim]. + eb, deb_dE ! The entrainment from below [H ~> m or kg m-2] and its derivative with E [nondim]. + real :: deriv_dSkb(SZI_(G)) ! The limited derivative of the new density difference across the base of + ! the buffer layers with the new density of the bottommost buffer layer [nondim] + real :: d1(SZI_(G)) ! d1 = 1.0-c1 is also used by the tridiagonal solver [nondim]. + real :: src ! A source term for dS_dR [R ~> kg m-3]. real :: h1 ! The thickness in excess of the minimum that will remain ! after exchange with the layer below [H ~> m or kg m-2]. logical, dimension(SZI_(G)) :: do_i @@ -1247,13 +1251,15 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness [H ~> m or kg m-2]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. - real :: rat - real :: dS_kbp1, IdS_kbp1 - real :: deriv_dSLay - real :: Inv_term ! [nondim] + real :: rat ! A ratio of density differences [nondim] + real :: dS_kbp1 ! The density difference between the top two interior layers [R ~> kg m-3]. + real :: IdS_kbp1 ! The inverse of dS_kbp1 [R-1 ~> m3 kg-1] + real :: deriv_dSLay ! The derivative of the projected density difference across the topmost interior + ! layer with the density difference across the interface above it [nondim] + real :: Inv_term ! The inverse of a nondimensional expression [nondim] real :: f1, df1_drat ! Temporary variables [nondim]. real :: z, dz_drat, f2, df2_dz, expz ! Temporary variables [nondim]. - real :: eps_dSLay, eps_dSkb ! Small nondimensional constants. + real :: eps_dSLay, eps_dSkb ! Small nondimensional constants [nondim]. integer :: i, k if (present(ddSlay_dE) .and. .not.present(dSlay)) call MOM_error(FATAL, & @@ -1447,16 +1453,21 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination !! of the entrainment [H ~> m or kg m-2]. - real :: max_ea, min_ea - real :: err, err_min, err_max - real :: derr_dea - real :: val, tolerance, tol1 - real :: ea_prev - real :: dS_kbp1 - logical :: bisect_next, Newton - real, dimension(SZI_(G)) :: dS_kb - real, dimension(SZI_(G)) :: maxF, ent_maxF, zeros - real, dimension(SZI_(G)) :: ddSkb_dE + real :: max_ea, min_ea ! Bounds on the estimated entraiment [H ~> m or kg m-2] + real :: err, err_min, err_max ! Errors in the mass flux balance [H R ~> kg m-2 or kg2 m-5] + real :: derr_dea ! The change in error with the change in ea [R ~> kg m-3] + real :: val ! An estimate mass flux [H R ~> kg m-2 or kg2 m-5] + real :: tolerance, tol1 ! Tolerances for the determination of the entrainment [H ~> m or kg m-2] + real :: ea_prev ! A previous estimate of ea_kb [H ~> m or kg m-2] + real :: dS_kbp1 ! The density difference between two interior layers [R ~> kg m-3] + real :: dS_kb(SZI_(G)) ! The limited potential density difference across the interface + ! between the bottommost buffer layer and the topmost interior layer [R ~> kg m-3] + real :: maxF(SZI_(G)) ! The maximum value of F (the density flux divided by density + ! differences) found in the range min_ent < ent < max_ent [H ~> m or kg m-2]. + real :: ent_maxF(SZI_(G)) ! The value of entrainment that gives maxF [H ~> m or kg m-2] + real :: zeros(SZI_(G)) ! An array of zero entrainments [H ~> m or kg m-2] + real :: ddSkb_dE(SZI_(G)) ! The partial derivative of dS_kb with ea_kb [R H-1 ~> kg m-4 or m-1] + logical :: bisect_next, Newton ! These indicate what method the next iteration should use integer :: it integer, parameter :: MAXIT = 30 @@ -1589,13 +1600,15 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! The input value is the first guess. real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this !! routine) associated with the returned - !! solution. + !! solution [H2 ~> m2 or kg2 m-4] real, dimension(SZI_(G)), optional, intent(in) :: err_min_eakb0 !< The errors (locally defined) !! associated with min_eakb when ea_kbp1 = 0, - !! returned from a previous call to this fn. + !! returned from a previous call to this + !! subroutine [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G)), optional, intent(in) :: err_max_eakb0 !< The errors (locally defined) !! associated with min_eakb when ea_kbp1 = 0, - !! returned from a previous call to this fn. + !! returned from a previous call to this + !! subroutine [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the !! uppermost interior layer !! corresponding to the returned @@ -1719,7 +1732,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & Ent(i) = Ent(i) - err(i) / derror_dE(i) elseif (false_position(i) .and. & (error_maxE(i) - error_minE(i) < 0.9*large_err)) then - ! Use the false postion method if there are decent error estimates. + ! Use the false position method if there are decent error estimates. Ent(i) = E_min(i) + (E_max(i)-E_min(i)) * & (-error_minE(i)/(error_maxE(i) - error_minE(i))) false_position(i) = .false. @@ -1813,17 +1826,21 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & ! negative) value. It is faster to find the true maximum by first finding the ! unlimited maximum and comparing it to the limited value at max_ent_in. real, dimension(SZI_(G)) :: & - ent, & - minent, maxent, ent_best, & - F_max_ent_in, & - F_maxent, F_minent, F, F_best, & - dF_dent, dF_dE_max, dF_dE_min, dF_dE_best, & - dS_kb, dS_kb_lim, ddSkb_dE, dS_anom_lim, & - chg_prev, chg_pre_prev - real :: dF_dE_mean, maxslope, minslope - real :: tolerance - real :: ratio_select_end - real :: rat, max_chg, min_chg, chg1, chg2, chg + ent, & ! The updated estimate of the entrainment [H ~> m or kg m-2] + minent, maxent, ent_best, & ! Various previous estimates of the entrainment [H ~> m or kg m-2] + F_max_ent_in, & ! The value of F that gives the input maximum value of ent [H ~> m or kg m-2] + F_maxent, F_minent, F, F_best, & ! Various estimates of F [H ~> m or kg m-2] + dF_dent, dF_dE_max, dF_dE_min, dF_dE_best, & ! Various derivatives of F with ent [nondim] + dS_kb, & ! The density difference across the interface between the bottommost + ! buffer layer and the topmost interior layer [R ~> kg m-3] + dS_kb_lim, dS_anom_lim, & ! Various limits on dS_kb [R ~> kg m-3] + ddSkb_dE, & ! The partial derivative of dS_kb with ent [R H-1 ~> kg m-4 or m-1]. + chg_prev, chg_pre_prev ! Changes in estimates of the entrainment from previous iterations [H ~> m or kg m-2] + real :: dF_dE_mean, maxslope, minslope ! Various derivatives of F with ent [nondim] + real :: tolerance ! The tolerance within which ent must be converged [H ~> m or kg m-2] + real :: ratio_select_end, rat ! Fractional changes in the value of ent to use for the next iteration + ! relative to its bounded range [nondim] + real :: max_chg, min_chg, chg1, chg2, chg ! Changes in entrainment estimates [H ~> m or kg m-2] logical, dimension(SZI_(G)) :: do_i, last_it, need_bracket, may_use_best logical :: doany, OK1, OK2, bisect, new_min_bound integer :: i, it, is1, ie1 @@ -1876,14 +1893,14 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & maxslope = MAX(dF_dE_mean, dF_dE_min(i), dF_dE_max(i)) minslope = MIN(dF_dE_mean, dF_dE_min(i), dF_dE_max(i)) if (F_minent(i) >= F_maxent(i)) then - if (dF_dE_min(i) > 0.0) then ; rat = 0.02 ! A small step should bracket the soln. + if (dF_dE_min(i) > 0.0) then ; rat = 0.02 ! A small step should bracket the solution. elseif (maxslope < ratio_select_end*minslope) then ! The maximum of F is at minent. F_best(i) = F_minent(i) ; ent_best(i) = minent(i) ; rat = 0.0 do_i(i) = .false. else ; rat = 0.382 ; endif ! Use the golden ratio else - if (dF_dE_max(i) < 0.0) then ; rat = 0.98 ! A small step should bracket the soln. + if (dF_dE_max(i) < 0.0) then ; rat = 0.98 ! A small step should bracket the solution. elseif (minslope > ratio_select_end*maxslope) then ! The maximum of F is at maxent. F_best(i) = F_maxent(i) ; ent_best(i) = maxent(i) ; rat = 1.0 @@ -1979,7 +1996,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & new_min_bound = .true. ! We have a new minimum bound. elseif ((F(i) <= F_maxent(i)) .and. (F(i) > F_minent(i))) then new_min_bound = .false. ! We have a new maximum bound. - else ! This case would bracket a minimum. Wierd. + else ! This case would bracket a minimum. Weird. ! Unless the derivative indicates that there is a maximum near the ! lower bound, try keeping the end with the larger value of F ! in a tie keep the minimum as the answer here will be compared @@ -2068,14 +2085,14 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control struct + type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control structure logical, intent(in) :: just_read_params !< If true, this call will only read !! and log parameters without registering !! any diagnostics ! Local variables - real :: dt ! The dynamics timestep, used here in the default for TOLERANCE_ENT, in MKS units [s] - real :: Kd ! A diffusivity used in the default for TOLERANCE_ENT, in MKS units [m2 s-1] + real :: dt ! The dynamics timestep, used here in the default for TOLERANCE_ENT [T ~> s] + real :: Kd ! A diffusivity used in the default for TOLERANCE_ENT [Z2 T-1 ~> m2 s-1] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. @@ -2090,14 +2107,14 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & "The maximum number of iterations that may be used to "//& "calculate the interior diapycnal entrainment.", default=5, do_not_log=just_read_params) - ! In this module, KD is only used to set the default for TOLERANCE_ENT. [m2 s-1] - call get_param(param_file, mdl, "KD", Kd, default=0.0) + ! In this module, KD is only used to set the default for TOLERANCE_ENT. [Z2 T-1 ~> m2 s-1] + call get_param(param_file, mdl, "KD", Kd, units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DT", dt, & - "The (baroclinic) dynamics time step.", units = "s", & - fail_if_missing=.true., do_not_log=just_read_params) + "The (baroclinic) dynamics time step.", & + units="s", scale=US%s_to_T, fail_if_missing=.true., do_not_log=just_read_params) call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H, & + units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)*US%Z_to_m), scale=GV%m_to_H, & do_not_log=just_read_params) CS%Rho_sig_off = 1000.0*US%kg_m3_to_R @@ -2119,10 +2136,10 @@ end subroutine entrain_diffusive_init !! mixing and advection in isopycnal layers. The main subroutine, !! calculate_entrainment, returns the entrainment by each layer !! across the interfaces above and below it. These are calculated -!! subject to the constraints that no layers can be driven to neg- -!! ative thickness and that the each layer maintains its target -!! density, using the scheme described in Hallberg (MWR 2000). There -!! may or may not be a bulk mixed layer above the isopycnal layers. +!! subject to the constraints that no layers can be driven to negative +!! thickness and that the each layer maintains its target density, +!! using the scheme described in Hallberg (MWR 2000). There may or +!! may not be a bulk mixed layer above the isopycnal layers. !! The solution is iterated until the change in the entrainment !! between successive iterations is less than some small tolerance. !! @@ -2134,9 +2151,9 @@ end subroutine entrain_diffusive_init !! diffusion, so the fully implicit upwind differencing scheme that !! is used is entirely appropriate. The downward buoyancy flux in !! each layer is determined from an implicit calculation based on -!! the previously calculated flux of the layer above and an estim- -!! ated flux in the layer below. This flux is subject to the foll- -!! owing conditions: (1) the flux in the top and bottom layers are +!! the previously calculated flux of the layer above and an estimated +!! flux in the layer below. This flux is subject to the following +!! conditions: (1) the flux in the top and bottom layers are !! set by the boundary conditions, and (2) no layer may be driven !! below an Angstrom thickness. If there is a bulk mixed layer, the !! mixed and buffer layers are treated as Eulerian layers, whose diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index c088eea5bb..1e8015eacd 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -356,8 +356,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. !! The previous value is used to initialize kappa - !! in the vertex columes as Kappa = Kv/Prandtl - !! to accelerate the iteration toward covergence. + !! in the vertex columns as Kappa = Kv/Prandtl + !! to accelerate the iteration toward convergence. real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. @@ -650,7 +650,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & S2, & ! The squared shear at an interface [T-2 ~> s-2]. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] - c1, & ! c1 is used in the tridiagonal (and similar) solvers. + c1, & ! c1 is used in the tridiagonal (and similar) solvers [nondim]. k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. kappa_out, & ! The kappa that results from the kappa equation [Z2 T-1 ~> m2 s-1]. @@ -675,9 +675,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & ! sources from the elliptic term [T-1 ~> s-1]. real :: dist_from_bot ! The distance from the bottom surface [Z ~> m]. - real :: b1 ! The inverse of the pivot in the tridiagonal equations. - real :: bd1 ! A term in the denominator of b1. - real :: d1 ! 1 - c1 in the tridiagonal equations. + real :: b1 ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. + real :: bd1 ! A term in the denominator of b1 [Z ~> m]. + real :: d1 ! 1 - c1 in the tridiagonal equations [nondim] real :: gR0 ! A conversion factor from Z to pressure, given by Rho_0 times g ! [R L2 T-2 Z-1 ~> kg m-2 s-2]. real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z R-1 T-2 ~> m4 kg-1 s-2]. @@ -1060,10 +1060,13 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int !! diffusivity. ! Local variables - real, dimension(nz+1) :: c1 - real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared [Z2 s2 T-2 m-2 ~> 1]. - real :: a_a, a_b, b1, d1, bd1, b1nz_0 + real, dimension(nz+1) :: c1 ! A tridiagonal variable [nondim] + real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth + ! units squared [Z2 s2 T-2 m-2 ~> 1]. + real :: a_a, a_b ! Tridiagonal coupling coefficients [Z ~> m] + real :: b1, b1nz_0 ! Tridiagonal variables [Z-1 ~> m-1] + real :: bd1 ! A term in the denominator of b1 [Z ~> m] + real :: d1 ! A tridiagonal variable [nondim] integer :: k, ks, ke ks = 1 ; ke = nz @@ -1166,7 +1169,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces - !! [Z-1 ~> m-1]. + !! [Z ~> m]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries [Z-2 ~> m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. @@ -1203,7 +1206,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [T ~> s]. dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [T-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the - ! TKE of the layer above when all the kappas below are 0. + ! TKE of the layer above when all the kappas below are 0 [nondim]. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear ! and stratification [Z2 T-3 ~> m2 s-3]. (For convenience, @@ -1213,13 +1216,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. real :: bQd1 ! A term in the denominator of bQ [Z T-1 ~> m s-1]. real :: bKd1 ! A term in the denominator of bK [Z ~> m]. - real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. + real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations [nondim]. real :: c_s2 ! The coefficient for the decay of TKE due to - ! shear (i.e. proportional to |S|*tke), nondimensional. + ! shear (i.e. proportional to |S|*tke) [nondim]. real :: c_n2 ! The coefficient for the decay of TKE due to ! stratification (i.e. proportional to N*tke) [nondim]. real :: Ri_crit ! The critical shear Richardson number for shear- - ! driven mixing. The theoretical value is 0.25. + ! driven mixing [nondim]. The theoretical value is 0.25. real :: q0 ! The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be @@ -1227,31 +1230,33 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: kappa0 ! The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. - real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. + real :: eden1, eden2 ! Variables used in calculating e1 [Z-1 ~> m-1] + real :: I_eden ! The inverse of the denominator in e1 [Z ~> m] + real :: ome ! Variables used in calculating e1 [nondim] real :: diffusive_src ! The diffusive source in the kappa equation [Z T-1 ~> m s-1]. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]. real :: kappa_mean ! A mean value of kappa [Z2 T-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next - ! iteration to use Newton's method. + ! iteration to use Newton's method [nondim]. ! Temporary variables used in the Newton's method iterations. - real :: decay_term_k ! The decay term in the diffusivity equation + real :: decay_term_k ! The decay term in the diffusivity equation [Z-1 ~> m-1] real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1] real :: I_Q ! The inverse of TKE [T2 Z-2 ~> s2 m-2] - real :: kap_src + real :: kap_src ! A source term in the kappa equation [Z T-1 ~> m s-1] real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] - real :: v2 - real :: tol_err ! The tolerance for max_err that determines when to - ! stop iterating. - real :: Newton_err ! The tolerance for max_err that determines when to - ! start using Newton's method. Empirically, an initial - ! value of about 0.2 seems to be most efficient. - real, parameter :: roundoff = 1.0e-16 ! A negligible fractional change in TKE. - ! This could be larger but performance gains are small. + real :: v2 ! A temporary variable in [Z T-2 ~> m s-2] + real :: tol_err ! The tolerance for max_err that determines when to + ! stop iterating [nondim]. + real :: Newton_err ! The tolerance for max_err that determines when to + ! start using Newton's method [nondim]. Empirically, an initial + ! value of about 0.2 seems to be most efficient. + real, parameter :: roundoff = 1.0e-16 ! A negligible fractional change in TKE [nondim]. + ! This could be larger but performance gains are small. logical :: tke_noflux_bottom_BC = .false. ! Specify the boundary conditions - logical :: tke_noflux_top_BC = .false. ! that are applied to the TKE eqns. + logical :: tke_noflux_top_BC = .false. ! that are applied to the TKE equations. logical :: do_Newton ! If .true., use Newton's method for the next iteration. logical :: abort_Newton ! If .true., an Newton's method has encountered a 0 ! pivot, and should not have been used. @@ -1265,7 +1270,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! These variables are used only for debugging. logical, parameter :: debug_soln = .false. - real :: K_err_lin, Q_err_lin + real :: K_err_lin ! The imbalance in the K equation [Z T-1 ~> m s-1] + real :: Q_err_lin ! The imbalance in the Q equation [Z2 T-3 ~> m2 s-3] real, dimension(nz+1) :: & I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. @@ -1726,15 +1732,15 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) logical :: kappa_shear_init !< True if module is to be used, False otherwise ! Local variables + real :: KD_normal ! The KD of the main model, read here only as a parameter + ! for setting the default of KD_SMOOTH [Z2 T-1 ~> m2 s-1] + real :: kappa_0_default ! The default value for KD_KAPPA_SHEAR_0 [Z2 T-1 ~> m2 s-1] logical :: merge_mixedlayer logical :: debug_shear logical :: just_read ! If true, this module is not used, so only read the parameters. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name. - real :: kappa_0_unscaled ! The value of kappa_0 in MKS units [m2 s-1] - real :: KD_normal ! The KD of the main model, read here only as a parameter - ! for setting the default of KD_SMOOTH in MKS units [m2 s-1] if (associated(CS)) then call MOM_error(WARNING, "kappa_shear_init called with an associated "// & @@ -1775,18 +1781,21 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MAX_RINO_IT", CS%max_RiNo_it, & "The maximum number of iterations that may be used to "//& "estimate the Richardson number driven mixing.", & - default=50, do_not_log=just_read) - call get_param(param_file, mdl, "KD", KD_normal, default=0.0, do_not_log=.true.) + units="nondim", default=50, do_not_log=just_read) + call get_param(param_file, mdl, "KD", KD_normal, & + units="m2 s-1", scale=US%m2_s_to_Z2_T, default=0.0, do_not_log=.true.) + kappa_0_default = max(Kd_normal, 1.0e-7*US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the "//& "density and shear profiles before solving for the "//& "diffusivities. The default is the greater of KD and 1e-7 m2 s-1.", & - units="m2 s-1", default=max(KD_normal, 1.0e-7), scale=US%m2_s_to_Z2_T, & - unscaled=kappa_0_unscaled, do_not_log=just_read) + units="m2 s-1", default=kappa_0_default*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, & + do_not_log=just_read) call get_param(param_file, mdl, "KD_TRUNC_KAPPA_SHEAR", CS%kappa_trunc, & "The value of shear-driven diffusivity that is considered negligible "//& "and is rounded down to 0. The default is 1% of KD_KAPPA_SHEAR_0.", & - units="m2 s-1", default=0.01*kappa_0_unscaled, scale=US%m2_s_to_Z2_T, do_not_log=just_read) + units="m2 s-1", default=0.01*CS%kappa_0*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, & + do_not_log=just_read) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the "//& "Richardson number in the kappa source term in the "//& @@ -1950,7 +1959,7 @@ end function kappa_shear_at_vertex !! TKE with shear and stratification fixed, then marches the density !! and velocities forward with an adaptive (and aggressive) time step !! in a predictor-corrector-corrector emulation of a trapezoidal -!! scheme. Run-time-settable parameters determine the tolerence to +!! scheme. Run-time-settable parameters determine the tolerance to !! which the kappa and TKE equations are solved and the minimum time !! step that can be taken. diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index deb1c90ca9..8966c12b79 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -151,10 +151,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) ! the coordinate variable, set to P_Ref [R L2 T-2 ~> Pa]. Rcv_tol, & ! A tolerence, relative to the target density differences ! between layers, for detraining into the interior [nondim]. - h_add_tgt, h_add_tot, & - h_tot1, Th_tot1, Sh_tot1, & - h_tot3, Th_tot3, Sh_tot3, & - h_tot2, Th_tot2, Sh_tot2 + h_add_tgt, & ! The target for the thickness to add to the mixed layers [H ~> m or kg m-2] + h_add_tot, & ! The net thickness added to the mixed layers [H ~> m or kg m-2] + h_tot1, h_tot2, h_tot3, & ! Debugging diagnostics of total thicknesses [H ~> m or kg m-2] + Th_tot1, Th_tot2, Th_tot3, & ! Debugging diagnostics of integrated temperatures [C H ~> degC m or degC kg m-2] + Sh_tot1, Sh_tot2, Sh_tot3 ! Debugging diagnostics of integrated salinities [S H ~> ppt m or ppt kg m-2] real, dimension(SZK_(GV)) :: & h_prev_1d ! The previous thicknesses [H ~> m or kg m-2]. real :: I_dtol ! The inverse of the tolerance changes [nondim]. @@ -168,16 +169,17 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) int_flux, & ! Mass flux across the interfaces [H ~> m or kg m-2] int_Tflux, & ! Temperature flux across the interfaces [C H ~> degC m or degC kg m-2] int_Sflux ! Salinity flux across the interfaces [S H ~> ppt m or ppt kg m-2] - real :: h_add - real :: h_det_tot - real :: max_def_rat + real :: h_add ! The thickness to add to the layers above an interface [H ~> m or kg m-2] + real :: h_det_tot ! The total thickness detrained by the mixed layers [H ~> m or kg m-2] + real :: max_def_rat ! The maximum value of the ratio of the thickness deficit to the minimum depth [nondim] real :: Rcv_min_det ! The lightest (min) and densest (max) coordinate density real :: Rcv_max_det ! that can detrain into a layer [R ~> kg m-3]. - real :: int_top, int_bot - real :: h_predicted - real :: h_prev - real :: h_deficit + real :: int_top, int_bot ! The interface depths above and below a layer [H ~> m or kg m-2], positive upward. + real :: h_predicted ! An updated thickness [H ~> m or kg m-2] + real :: h_prev ! The previous thickness [H ~> m or kg m-2] + real :: h_deficit ! The difference between the layer thickness and the value estimated from the + ! filtered interface depths [H ~> m or kg m-2] logical :: cols_left, ent_any, more_ent_i(SZI_(G)), ent_i(SZI_(G)) logical :: det_any, det_i(SZI_(G)) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 6d35616b3a..8257d19bd3 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -69,8 +69,7 @@ module MOM_set_diffusivity !! drag law c_drag*|u|*u. logical :: BBL_mixing_as_max !< If true, take the maximum of the diffusivity !! from the BBL mixing and the other diffusivities. - !! Otherwise, diffusivities from the BBL_mixing is - !! added. + !! Otherwise, diffusivities from the BBL_mixing is added. logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. real :: Von_Karm !< The von Karman constant as used in the BBL diffusivity calculation @@ -115,10 +114,9 @@ module MOM_set_diffusivity !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence !! radiated from the base of the mixed layer [Z2 T-1 ~> m2 s-1]. - real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth - real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to - !! obtain energy available for mixing below - !! mixed layer base [nondim] + real :: ML_rad_efold_coeff !< Coefficient to scale penetration depth [nondim] + real :: ML_rad_coeff !< Coefficient which scales MSTAR*USTAR^3 to obtain energy + !! available for mixing below mixed layer base [nondim] logical :: ML_rad_bug !< If true use code with a bug that reduces the energy available !! in the transition layer by a factor of the inverse of the energy !! deposition lenthscale (in m). @@ -135,7 +133,7 @@ module MOM_set_diffusivity !! of the vertical component of rotation when !! setting the decay scale for mixed layer turbulence. real :: ML_omega_frac !< When setting the decay scale for turbulence, use - !! this fraction of the absolute rotation rate blended + !! this fraction [nondim] of the absolute rotation rate blended !! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. logical :: user_change_diff !< If true, call user-defined code to change diffusivity. logical :: useKappaShear !< If true, use the kappa_shear module to find the @@ -149,9 +147,9 @@ module MOM_set_diffusivity logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that !! does not rely on a layer-formulation. - real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering + real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering [nondim] real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] - real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] + real :: Kv_molecular !< Molecular viscosity for double diffusive convection [Z2 T-1 ~> m2 s-1] integer :: answer_date !< The vintage of the order of arithmetic and expressions in this module's !! calculations. Values below 20190101 recover the answers from the @@ -185,9 +183,9 @@ module MOM_set_diffusivity Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [R Z3 T-3 ~> W m-2] maxTKE => NULL(), & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] Kd_bkgnd => NULL(), & !< Background diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - Kv_bkgnd => NULL(), & !< Viscosity from ackground diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 T-1 ~> m2 s-1]. - KS_extra => NULL(), & !< double diffusion diffusivity for saln [Z2 T-1 ~> m2 s-1]. + Kv_bkgnd => NULL(), & !< Viscosity from background diffusivity at interfaces [Z2 T-1 ~> m2 s-1] + KT_extra => NULL(), & !< Double diffusion diffusivity for temperature [Z2 T-1 ~> m2 s-1]. + KS_extra => NULL(), & !< Double diffusion diffusivity for salinity [Z2 T-1 ~> m2 s-1]. drho_rat => NULL() !< The density difference ratio used in double diffusion [nondim]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE @@ -262,8 +260,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i Kd_int_2d, & !< The interface diffusivities [Z2 T-1 ~> m2 s-1] Kv_bkgnd, & !< The background diffusion related interface viscosities [Z2 T-1 ~> m2 s-1] dRho_int, & !< Locally referenced potential density difference across interfaces [R ~> kg m-3] - KT_extra, & !< Double difusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] - KS_extra !< Double difusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] + KT_extra, & !< Double diffusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] + KS_extra !< Double diffusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] real :: dissip ! local variable for dissipation calculations [Z2 R T-3 ~> W m-3] real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] @@ -673,7 +671,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(out) :: TKE_to_Kd !< The conversion rate between the !! TKE dissipated within a layer and the - !! diapycnal diffusivity witin that layer, + !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain @@ -701,12 +699,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & Rcv_kmb, & ! coordinate density in the lowest buffer layer [R ~> kg m-3] p_0 ! An array of 0 pressures [R L2 T-2 ~> Pa] - real :: dh_max ! maximum amount of entrainment a layer could - ! undergo before entraining all fluid in the layers - ! above or below [Z ~> m]. + real :: dh_max ! maximum amount of entrainment a layer could undergo before + ! entraining all fluid in the layers above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [R ~> kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z T-2 R-1 ~> m4 s-2 kg-1] + real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density [Z T-2 R-1 ~> m4 s-2 kg-1] real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z T-2 R-1 ~> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [R-1 ~> m3 kg-1] real :: I_dt ! 1/dt [T-1 ~> s-1] @@ -911,16 +908,16 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & z_from_bot ! The hieght above the bottom [Z ~> m]. real :: dz_int ! thickness associated with an interface [Z ~> m]. - real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density + real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density ! times some unit conversion factors [Z T-2 R-1 ~> m4 s-2 kg-1]. - real :: H_neglect ! negligibly small thickness, in the same units as h. + real :: H_neglect ! A negligibly small thickness [H ~> m or kg m-2] logical :: do_i(SZI_(G)), do_any integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = GV%ke - G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1064,8 +1061,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp [R C-1 ~> kg m-3 degC-1] - dRho_dS, & ! partial derivatives of density wrt saln [R S-1 ~> kg m-3 ppt-1] + dRho_dT, & ! partial derivatives of density with respect to temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & ! partial derivatives of density with respect to salinity [R S-1 ~> kg m-3 ppt-1] pres, & ! pressure at each interface [R L2 T-2 ~> Pa] Temp_int, & ! temperature at interfaces [C ~> degC] Salin_int ! Salinity at interfaces [S ~> ppt] @@ -1076,7 +1073,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real :: Rrho ! vertical density ratio [nondim] real :: diff_dd ! factor for double-diffusion [nondim] real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 T-1 ~> m2 s-1] - real :: prandtl ! flux ratio for diffusive convection regime + real :: prandtl ! flux ratio for diffusive convection regime [nondim] real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim] @@ -1146,7 +1143,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the - !! diapycnal diffusivity witin that layer, + !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain @@ -1274,7 +1271,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! if (maxEnt(i,k) <= 0.0) cycle if (maxTKE(i,k) <= 0.0) cycle - ! This is an analytic integral where diffusity is a quadratic function of + ! This is an analytic integral where diffusivity is a quadratic function of ! rho that goes asymptotically to 0 at Rho_top (vaguely following KPP?). if (TKE(i) > 0.0) then if (Rint(K) <= Rho_top(i)) then @@ -1395,7 +1392,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int real :: ustar ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: ustar2 ! square of ustar, for convenience [Z2 T-2 ~> m2 s-2] real :: absf ! average absolute value of Coriolis parameter around a thickness point [T-1 ~> s-1] - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely [Z ~> m]. + real :: dh, dhm1 ! thickness of layers k and k-1, respectively [Z ~> m]. real :: z_bot ! distance to interface k from bottom [Z ~> m]. real :: D_minus_z ! distance to interface k from surface [Z ~> m]. real :: total_thickness ! total thickness of water column [Z ~> m]. @@ -1550,7 +1547,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]. real :: ustar_sq ! ustar squared [Z2 T-2 ~> m2 s-2] real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 T-1 ~> m2 s-1]. - real :: C1_6 ! 1/6 + real :: C1_6 ! 1/6 [nondim] real :: Omega2 ! rotation rate squared [T-2 ~> s-2]. real :: z1 ! layer thickness times I_decay [nondim] real :: dzL ! thickness converted to heights [Z ~> m]. @@ -1623,7 +1620,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (CS%ML_Rad_bug) then - ! These expresssions are dimensionally inconsistent. -RWH + ! These expressions are dimensionally inconsistent. -RWH ! This is supposed to be the integrated energy deposited in the layer, ! not the average over the layer as in these expressions. if (z1 > 1e-5) then @@ -1881,8 +1878,8 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) ! Local variables real :: g_R0 ! g_R0 is a rescaled version of g/Rho [L2 Z-1 R-1 T-2 ~> m4 kg-1 s-2] - real :: eps, tmp ! nondimensional temporary variables - real :: a(SZK_(GV)), a_0(SZK_(GV)) ! nondimensional temporary variables + real :: eps, tmp ! nondimensional temporary variables [nondim] + real :: a(SZK_(GV)), a_0(SZK_(GV)) ! nondimensional temporary variables [nondim] real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures [R L2 T-2 ~> Pa] real :: Rcv(SZI_(G),SZK_(GV)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3] real :: I_Drho ! temporary variable [R-1 ~> m3 kg-1] @@ -1950,7 +1947,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) do k3=2,kmb ! ds_dsp1(i,k3) = MAX(a(k3),1e-5) - ! Deliberately treat convective instabilies of the upper mixed + ! Deliberately treat convective instabilities of the upper mixed ! and buffer layers with respect to the deepest buffer layer as ! though they don't exist. They will be eliminated by the upcoming ! call to the mixedlayer code anyway. @@ -1974,7 +1971,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output. type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control !! structure. - type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control struct + type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control structure integer, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. logical, intent(out) :: double_diffuse !< This indicates whether some version @@ -1986,7 +1983,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ !! surface boundary layer. ! Local variables - real :: decay_length + real :: decay_length ! The maximum decay scale for the BBL diffusion [Z ~> m] logical :: ML_use_omega integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -2176,7 +2173,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "for an isopycnal layer-formulation.", & default=.false., do_not_log=.not.TKE_to_Kd_used) - ! set params related to the background mixing + ! set parameters related to the background mixing call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp, physical_OBL_scheme) call get_param(param_file, mdl, "KV", CS%Kv, & @@ -2340,7 +2337,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ end subroutine set_diffusivity_init -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory subroutine set_diffusivity_end(CS) type(set_diffusivity_CS), intent(inout) :: CS !< Control structure for this module diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index e9497d0e92..249cbb5777 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -48,10 +48,10 @@ module MOM_set_visc logical :: initialized = .false. !< True if this control structure has been initialized. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. !! Runtime parameter `HBBL`. - real :: cdrag !< The quadratic drag coefficient. + real :: cdrag !< The quadratic drag coefficient [nondim]. !! Runtime parameter `CDRAG`. real :: c_Smag !< The Laplacian Smagorinsky coefficient for - !! calculating the drag in channels. + !! calculating the drag in channels [nondim]. real :: drag_bg_vel !< An assumed unresolved background velocity for !! calculating the bottom drag [L T-1 ~> m s-1]. !! Runtime parameter `DRAG_BG_VEL`. @@ -233,7 +233,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: C24_a ! 24/a [H-1 ~> m-1 or m2 kg-1]. real :: slope ! The absolute value of the bottom depth slope across ! a cell times the cell width [H ~> m or kg m-2]. - real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope. + real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope [nondim]. real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope [H-1 ~> m-1 or m2 kg-1]. ! All of the following "volumes" have units of thickness because they are normalized ! by the full horizontal area of a velocity cell. @@ -282,12 +282,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: h_bbl_fr ! The fraction of the bottom boundary layer in a layer [nondim]. real :: h_sum ! The sum of the thicknesses of the layers below the one being ! worked on [H ~> m or kg m-2]. - real, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 - real :: C2pi_3 ! An irrational constant, 2/3 pi. - real :: tmp ! A temporary variable. - real :: tmp_val_m1_to_p1 + real, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 ! Rational constants [nondim] + real :: C2pi_3 ! An irrational constant, 2/3 pi. [nondim] + real :: tmp ! A temporary variable, sometimes in [Z ~> m] + real :: tmp_val_m1_to_p1 ! A temporary variable [nondim] real :: curv_tol ! Numerator of curvature cubed, used to estimate - ! accuracy of a single L(:) Newton iteration + ! accuracy of a single L(:) Newton iteration [H5 ~> m3 or kg5 m-10] logical :: use_L0, do_one_L_iter ! Control flags for L(:) Newton iteration logical :: use_BBL_EOS, do_i(SZIB_(G)) integer, dimension(2) :: EOSdom ! The computational domain for the equation of state @@ -1099,7 +1099,7 @@ function set_v_at_u(v, h, G, GV, i, j, k, mask2dCv, OBC) integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. real, dimension(SZI_(G),SZJB_(G)),& - intent(in) :: mask2dCv !< A multiplicative mask of the v-points + intent(in) :: mask2dCv !< A multiplicative mask of the v-points [nondim] type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure real :: set_v_at_u !< The return value of v at u points points in the !! same units as u, i.e. [L T-1 ~> m s-1] or other units. @@ -1144,7 +1144,7 @@ function set_u_at_v(u, h, G, GV, i, j, k, mask2dCu, OBC) integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: mask2dCu !< A multiplicative mask of the u-points + intent(in) :: mask2dCu !< A multiplicative mask of the u-points [nondim] type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure real :: set_u_at_v !< The return value of u at v points in the !! same units as u, i.e. [L T-1 ~> m s-1] or other units. @@ -1213,8 +1213,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) Rhtot, & ! The integrated density of layers that are within the surface mixed layer ! [H R ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. - uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + uhtot, & ! The depth integrated zonal velocity within the surface + ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! The depth integrated meridional velocity within the surface + ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [R C-1 ~> kg m-3 degC-1]. @@ -1261,8 +1263,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) ! on the mixed layer thickness and density difference across ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. real :: RiBulk ! The bulk Richardson number below which water is in the - ! viscous mixed layer, including reduction for turbulent - ! decay. Nondimensional. + ! viscous mixed layer, including reduction for turbulent decay [nondim] real :: dt_Rho0 ! The time step divided by the conversion from the layer ! thickness to layer mass [T H Z-1 R-1 ~> s m3 kg-1 or s]. real :: g_H_Rho0 ! The gravitational acceleration times the conversion from H to m divided @@ -1871,7 +1872,7 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) logical :: adiabatic, useKPP, useEPBL logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv integer :: isd, ied, jsd, jed, nz - real :: hfreeze !< If hfreeze > 0 [m], melt potential will be computed. + real :: hfreeze !< If hfreeze > 0 [Z ~> m], melt potential will be computed. character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -1929,7 +1930,7 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) default=.false., do_not_log=.true.) ! visc%MLD needs to be allocated when melt potential is computed (HFREEZE>0) call get_param(param_file, mdl, "HFREEZE", hfreeze, & - default=-1.0, do_not_log=.true.) + units="m", default=-1.0, scale=US%m_to_Z, do_not_log=.true.) if (MLE_use_PBL_MLD) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) @@ -2001,11 +2002,11 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [m] real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a restart file to the internal representation in this run. + ! a restart file to the internal representation in this run [nondim]? real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run - ! to the representation in a restart file. + ! to the representation in a restart file [nondim]? real :: Z2_T_rescale ! A rescaling factor for vertical diffusivities and viscosities from the - ! representation in a restart file to the internal representation in this run. + ! representation in a restart file to the internal representation in this run [nondim]? integer :: i, j, k, is, ie, js, je integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. @@ -2100,14 +2101,14 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "determine the mixed layer thickness for viscosity.", & default=.false.) if (CS%dynamic_viscous_ML) then - call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, default=0.0) + call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, units="nondim", default=0.0) call get_param(param_file, mdl, "BULK_RI_ML_VISC", CS%bulk_Ri_ML, & "The efficiency with which mean kinetic energy released "//& "by mechanically forced entrainment of the mixed layer "//& "is converted to turbulent kinetic energy. By default, "//& "BULK_RI_ML_VISC = BULK_RI_ML or 0.", units="nondim", & default=bulk_Ri_ML_dflt) - call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, default=0.0) + call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, units="nondim", default=0.0) call get_param(param_file, mdl, "TKE_DECAY_VISC", CS%TKE_decay, & "TKE_DECAY_VISC relates the vertical rate of decay of "//& "the TKE available for mechanical entrainment to the "//& @@ -2118,7 +2119,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& - "scale for turbulence.", default=.false., do_not_log=.true.) + "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then call MOM_error(WARNING, "ML_USE_OMEGA is deprecated; use ML_OMEGA_FRAC=1.0 instead.") @@ -2223,7 +2224,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS default=.false.) if (CS%Channel_drag) then - call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) + call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, units="nondim", default=-1.0) cSmag_chan_dflt = 0.15 if (smag_const1 >= 0.0) cSmag_chan_dflt = smag_const1 From d01c42ae9c478972afb697feda382c123b1e7c60 Mon Sep 17 00:00:00 2001 From: Angus Gibson Date: Tue, 22 Nov 2022 10:06:47 +1100 Subject: [PATCH 042/213] Use small minimum ustar in mixed layer restratification If the forcing ustar is exactly zero, the denominator of the momentum mixing rate term reduces to just the Coriolis parameter. With a grid construction that is symmetric about the equator, this term is also exactly zero, leading to a division by zero. To avoid this, a very small minimum ustar value is introduced, using the Earth's rotation as a velocity timescale, in the same manner as in some of the vertical parameterisations. This should prevent the denominator of the momentum mixing rate from going to zero. --- .../lateral/MOM_mixed_layer_restrat.F90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0aef33ddc6..506046340d 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -61,6 +61,7 @@ module MOM_mixed_layer_restrat type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real, dimension(:,:), allocatable :: & MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] @@ -160,6 +161,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] + real :: ustar_min ! A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux @@ -307,6 +309,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z + ustar_min = 2e-4 * CS%omega * US%T_to_S * (GV%Angstrom_Z + dz_neglect) if (CS%front_length>0.) then res_upscale = .true. I_LFront = 1. / CS%front_length @@ -378,7 +381,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -453,7 +456,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -627,6 +630,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] + real :: ustar_min ! A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] @@ -662,6 +666,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z + ustar_min = 2e-4 * CS%omega * US%T_to_S * (GV%Angstrom_Z + dz_neglect) if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -705,7 +710,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je ; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -751,7 +756,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -926,6 +931,10 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "used in the MLE scheme. This simply multiplies MLD wherever used.",& units="nondim", default=1.0) endif + call get_param(param_file, mdl, "OMEGA", CS%omega, & + "The rotation rate of the earth.", units="s-1", & + default=7.2921e-5, scale=US%T_to_s) + CS%diag => diag From e2ef845146b4db971c44c4f2adf4a27cd4e150ab Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 7 Dec 2022 13:58:54 -0500 Subject: [PATCH 043/213] Switch from mpich to openmpi Testing to see if GH actions is failing due to MPI installation --- .github/actions/ubuntu-setup/action.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/actions/ubuntu-setup/action.yml b/.github/actions/ubuntu-setup/action.yml index 3fd2ea13cf..3f3ba5f0b6 100644 --- a/.github/actions/ubuntu-setup/action.yml +++ b/.github/actions/ubuntu-setup/action.yml @@ -13,7 +13,7 @@ runs: sudo apt-get install netcdf-bin sudo apt-get install libnetcdf-dev sudo apt-get install libnetcdff-dev - sudo apt-get install mpich - sudo apt-get install libmpich-dev + sudo apt-get install openmpi-bin + sudo apt-get install libopenmpi-dev sudo apt-get install linux-tools-common echo "::endgroup::" From 01242a7bec3a2c17cf168977fff01d9dad11cf93 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 12 Sep 2022 08:53:10 -0400 Subject: [PATCH 044/213] makedep PEP8 cleanup This is a first pass to refactoring the makedep script, primarily to make it PEP8 compliant. --- ac/makedep | 233 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 138 insertions(+), 95 deletions(-) diff --git a/ac/makedep b/ac/makedep index 443371a79f..d201b49ab2 100755 --- a/ac/makedep +++ b/ac/makedep @@ -6,7 +6,8 @@ import argparse import glob import os import re -import sys # used only to get path to current script +import sys # used only to get path to current script + # Pre-compile re searches re_module = re.compile(r"^ *module +([a-z_0-9]+)") @@ -15,7 +16,9 @@ re_cpp_include = re.compile(r"^ *# *include *[<\"']([a-zA-Z_0-9\.]+)[>\"']") re_f90_include = re.compile(r"^ *include +[\"']([a-zA-Z_0-9\.]+)[\"']") re_program = re.compile(r"^ *[pP][rR][oO][gG][rR][aA][mM] +([a-zA-Z_0-9]+)") -def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, script_path): + +def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, + link_externals, script_path): """Create "makefile" after scanning "src_dis".""" # Scan everything Fortran related @@ -23,85 +26,92 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, # Lists of things # ... all F90 source - F90_files = [f for f in all_files if f.endswith('.f90') or f.endswith('.F90')] + F90_files = [ + f for f in all_files + if f.endswith('.f90') or f.endswith('.F90') + ] # ... all C source c_files = [f for f in all_files if f.endswith('.c')] # Dictionaries for associating files to files # maps basename of file to full path to file - f2F = dict( zip( [os.path.basename(f) for f in all_files], all_files ) ) + f2F = dict(zip([os.path.basename(f) for f in all_files], all_files)) # maps basename of file to directory - f2dir = dict( zip( [os.path.basename(f) for f in all_files], [os.path.dirname(f) for f in all_files] ) ) + f2dir = dict(zip([os.path.basename(f) for f in all_files], + [os.path.dirname(f) for f in all_files])) # Check for duplicate files in search path if not len(f2F) == len(all_files): a = [] for f in all_files: if os.path.basename(f) in a: - print('Warning: File %s was found twice! One is being ignored but which is undefined.'%(os.path.basename(f))) - a.append( os.path.basename(f) ) + print('Warning: File {} was found twice! One is being ignored ' + 'but which is undefined.'.format(os.path.basename(f))) + a.append(os.path.basename(f)) # maps object file to F90 source - o2F90 = dict( zip( [ object_file(f) for f in F90_files ], F90_files ) ) + o2F90 = dict(zip([object_file(f) for f in F90_files], F90_files)) # maps object file to C source - o2c = dict( zip( [ object_file(f) for f in c_files ], c_files ) ) + o2c = dict(zip([object_file(f) for f in c_files], c_files)) o2mods, o2uses, o2h, o2inc, o2prg, prg2o, mod2o = {}, {}, {}, {}, {}, {}, {} externals, all_modules = [], [] for f in F90_files: - mods, used, cpp, inc, prg = scan_fortran_file( f ) + mods, used, cpp, inc, prg = scan_fortran_file(f) # maps object file to modules produced - o2mods[ object_file(f) ] = mods + o2mods[object_file(f)] = mods # maps module produced to object file for m in mods: - mod2o[ m ] = object_file(f) + mod2o[m] = object_file(f) # maps object file to modules used - o2uses[ object_file(f) ] = used + o2uses[object_file(f)] = used # maps object file to .h files included - o2h[ object_file(f) ] = cpp + o2h[object_file(f)] = cpp # maps object file to .inc files included - o2inc[ object_file(f) ] = inc + o2inc[object_file(f)] = inc # maps object file to executables produced - o2prg[ object_file(f) ] = prg + o2prg[object_file(f)] = prg if prg: for p in prg: if p in prg2o.keys(): #raise ValueError("Files %s and %s both create the same program '%s'"%( # f,o2F90[prg2o[p]],p)) - print("Warning: Files %s and %s both create the same program '%s'"%( - f,o2F90[prg2o[p]],p)) - o = prg2o[ p ] - del prg2o[ p ] - #del o2prg[ o ] - need to keep so modifying instead - o2prg[ o ] = [ '[ignored %s]'%(p) ] + print("Warning: Files {} and {} both create the same " + "program '{}'".format(f, o2F90[prg2o[p]], p)) + o = prg2o[p] + del prg2o[p] + #del o2prg[o] - need to keep so modifying instead + o2prg[o] = ['[ignored %s]'%(p)] else: - prg2o[ p ] = object_file(f) + prg2o[p] = object_file(f) if not mods and not prg: - externals.append( object_file(f) ) + externals.append(object_file(f)) all_modules += mods for f in c_files: - _, _, cpp, inc, _ = scan_fortran_file( f ) + _, _, cpp, inc, _ = scan_fortran_file(f) # maps object file to .h files included - o2h[ object_file(f) ] = cpp + o2h[object_file(f)] = cpp # Are we building a library, single or multiple executables? targ_libs = [] if exec_target: if exec_target.endswith('.a'): - targ_libs.append( exec_target ) + targ_libs.append(exec_target) else: if len(prg2o.keys()) == 1: o = prg2o.values()[0] - del prg2o[ o2prg[o][0] ] - prg2o[ exec_target ] = o - o2prg[ o ] = exec_target + del prg2o[o2prg[o][0]] + prg2o[exec_target] = o + o2prg[o] = exec_target else: - raise ValueError("Option -x specified an executable name but none or multiple programs were found") - targets = [ exec_target ] + raise ValueError("Option -x specified an executable name but " + "none or multiple programs were found") + targets = [exec_target] else: if len(prg2o.keys()) == 0: - print("Warning: No programs were found and -x did not specify a library to build") + print("Warning: No programs were found and -x did not specify a " + "library to build") targets = prg2o.keys() # Create new makefile @@ -111,7 +121,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, print("# Invoked as", file=file) print('# '+' '.join(sys.argv), file=file) print("", file=file) - print("all:", " ".join( targets ), file=file) + print("all:", " ".join(targets), file=file) print("", file=file) #print("# SRC_DIRS is usually set in the parent Makefile but in case is it not we", file=file) @@ -123,14 +133,14 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, #print("", file=file) # Write rule for each object from Fortran - for o in sorted( o2F90.keys() ): + for o in sorted(o2F90.keys()): found_mods = [m for m in o2uses[o] if m in all_modules] missing_mods = [m for m in o2uses[o] if m not in all_modules] - incs = nested_inc( o2h[o] + o2inc[o], f2F ) - incdeps = sorted( set( [ f2F[f] for f in incs if f in f2F ] ) ) - incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) + incs = nested_inc(o2h[o] + o2inc[o], f2F) + incdeps = sorted(set([f2F[f] for f in incs if f in f2F])) + incargs = sorted(set(['-I'+os.path.dirname(f) for f in incdeps])) if debug: - print("# Source file %s produces:"%(o2F90[o]), file=file) + print("# Source file {} produces:".format(o2F90[o]), file=file) print("# object:", o, file=file) print("# modules:", ' '.join(o2mods[o]), file=file) print("# uses:", ' '.join(o2uses[o]), file=file) @@ -142,13 +152,13 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, print("# program:", ' '.join(o2prg[o]), file=file) if o2mods[o]: print(' '.join(o2mods[o])+':',o, file=file) - print(o+':', o2F90[o], ' '.join(incdeps+found_mods), file=file) + print(o + ':', o2F90[o], ' '.join(incdeps+found_mods), file=file) print('\t'+fc_rule, ' '.join(incargs), file=file) # Write rule for each object from C - for o in sorted( o2c.keys() ): - incdeps = sorted( set( [ f2F[h] for h in o2h[o] if h in f2F ] ) ) - incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) + for o in sorted(o2c.keys()): + incdeps = sorted(set([f2F[h] for h in o2h[o] if h in f2F])) + incargs = sorted(set(['-I'+os.path.dirname(f) for f in incdeps])) if debug: print("# Source file %s produces:"%(o2c[o]), file=file) print("# object:", o, file=file) @@ -161,23 +171,24 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, # Externals (so called) if link_externals: print("", file=file) - print("# Note: The following object files are not associated with modules so we assume we should link with them:", file=file) + print("# Note: The following object files are not associated with " + "modules so we assume we should link with them:", file=file) print("# ", ' '.join(externals), file=file) o2x = None else: externals = [] # Write rules for linking executables - for p in sorted( prg2o.keys() ): + for p in sorted(prg2o.keys()): o = prg2o[p] print("", file=file) - print(p+':',' '.join( link_obj(o, o2uses, mod2o, all_modules) + externals ), file=file ) + print(p+':',' '.join(link_obj(o, o2uses, mod2o, all_modules) + externals), file=file) print('\t$(LD) $(LDFLAGS) -o $@ $^ $(LIBS)', file=file) # Write rules for building libraries - for l in sorted( targ_libs ): + for l in sorted(targ_libs): print("", file=file) - print(l+':',' '.join( list(o2F90.keys()) + list(o2c.keys()) ), file=file ) + print(l+':',' '.join(list(o2F90.keys()) + list(o2c.keys())), file=file) print('\t$(AR) $(ARFLAGS) $@ $^', file=file) # Write cleanup rules @@ -190,11 +201,12 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, print("remakedep:", file=file) print('\t'+' '.join(sys.argv), file=file) + def link_obj(obj, o2uses, mod2o, all_modules): """List of all objects needed to link "obj",""" def recur(obj, depth=0): if obj not in olst: - olst.append( obj) + olst.append(obj) else: return uses = [m for m in o2uses[obj] if m in all_modules] @@ -205,97 +217,128 @@ def link_obj(obj, o2uses, mod2o, all_modules): recur(o, depth=depth+1) #if o not in olst: # recur(o, depth=depth+1) - # olst.append( o ) + # olst.append(o) return return olst = [] recur(obj) - return sorted( set( olst) ) + return sorted(set(olst)) + def nested_inc(inc_files, f2F): - """List of all files included by "inc_files", either by #include or F90 include.""" + """List of all files included by "inc_files", either by #include or F90 + include.""" def recur(hfile): if hfile not in f2F.keys(): return - _, _, cpp, inc, _ = scan_fortran_file( f2F[hfile] ) - if len(cpp)+len(inc)>0: + _, _, cpp, inc, _ = scan_fortran_file(f2F[hfile]) + if len(cpp) + len(inc) > 0: for h in cpp+inc: if h not in hlst and h in f2F.keys(): recur(h) - hlst.append( h ) + hlst.append(h) return return hlst = [] for h in inc_files: recur(h) - return inc_files + sorted( set( hlst ) ) + return inc_files + sorted(set(hlst)) + def scan_fortran_file(src_file): - """Scan the Fortran file "src_file" and return lists of module defined, module used, and files included.""" + """Scan the Fortran file "src_file" and return lists of module defined, + module used, and files included.""" module_decl, used_modules, cpp_includes, f90_includes, programs = [], [], [], [], [] with open(src_file, 'r') as file: lines = file.readlines() for line in lines: - match = re_module.match( line.lower() ) + match = re_module.match(line.lower()) if match: - if match.group(1) not in 'procedure': # avoid "module procedure" statements - module_decl.append( match.group(1) ) - match = re_use.match( line.lower() ) + if match.group(1) not in 'procedure': # avoid "module procedure" statements + module_decl.append(match.group(1)) + match = re_use.match(line.lower()) if match: - used_modules.append( match.group(1) ) - match = re_cpp_include.match( line ) + used_modules.append(match.group(1)) + match = re_cpp_include.match(line) if match: - cpp_includes.append( match.group(1) ) - match = re_f90_include.match( line ) + cpp_includes.append(match.group(1)) + match = re_f90_include.match(line) if match: - f90_includes.append( match.group(1) ) - match = re_program.match( line ) + f90_includes.append(match.group(1)) + match = re_program.match(line) if match: - programs.append( match.group(1) ) + programs.append(match.group(1)) used_modules = [m for m in sorted(set(used_modules)) if m not in module_decl] - return add_suff(module_decl, '.mod'), add_suff( used_modules, '.mod'), cpp_includes, f90_includes, programs - #return add_suff(module_decl, '.mod'), add_suff( sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs + return add_suff(module_decl, '.mod'), add_suff(used_modules, '.mod'), cpp_includes, f90_includes, programs + #return add_suff(module_decl, '.mod'), add_suff(sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs + def object_file(src_file): - """Return the name of an object file that results from compiling src_file.""" - return os.path.splitext( os.path.basename( src_file ) )[0] + '.o' + """Return the name of an object file that results from compiling + src_file.""" + return os.path.splitext(os.path.basename(src_file))[0] + '.o' def find_files(src_dirs): - """Return sorted list of all source files starting from each directory in the list "src_dirs".""" + """Return sorted list of all source files starting from each directory in + the list "src_dirs".""" files = [] for path in src_dirs: if not os.path.isdir(path): - raise ValueError("Directory '%s' was not found"%(path)) - for p, d, f in os.walk( os.path.normpath(path), followlinks=True): + raise ValueError("Directory '{}' was not found".format(path)) + for p, d, f in os.walk(os.path.normpath(path), followlinks=True): for file in f: - if file.endswith('.F90') or file.endswith('.f90') or file.endswith('.h') or file.endswith('.inc') or file.endswith('.c'): + # TODO: use any() + if (file.endswith('.F90') or file.endswith('.f90') + or file.endswith('.h') or file.endswith('.inc') + or file.endswith('.c')): files.append(p+'/'+file) - return sorted( set( files ) ) + return sorted(set(files)) + def add_suff(lst, suff): """Add "suff" to each item in the list""" - return [ f+suff for f in lst ] + return [f + suff for f in lst] + # Parse arguments parser = argparse.ArgumentParser( - description="Generate make dependencies for F90 source code.") -parser.add_argument('path', nargs='+', - help="Directories to search for source code.") -parser.add_argument('-o', '--makefile', default='Makefile.dep', - help="Name of Makefile to put dependencies in to. Default is Makefile.dep.") -parser.add_argument('-f', '--fc_rule', default="$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<", - help="""String to use in the compilation rule. Default is: - '$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'""") -parser.add_argument('-x', '--exec_target', - help="""Name of executable to build. - Fails if more than one program is found. - If EXEC ends in .a then a library is built.""") -parser.add_argument('-e', '--link_externals', action='store_true', - help="Always compile and link any files that do not produce modules (externals).") -parser.add_argument('-d', '--debug', action='store_true', - help="Annotate the makefile with extra information.") + description="Generate make dependencies for F90 source code." +) +parser.add_argument( + 'path', + nargs='+', + help="Directories to search for source code." +) +parser.add_argument( + '-o', '--makefile', + default='Makefile.dep', + help="Name of Makefile to put dependencies in to. Default is Makefile.dep." +) +parser.add_argument( + '-f', '--fc_rule', + default="$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<", + help="String to use in the compilation rule. Default is: " + "'$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'" +) +parser.add_argument( + '-x', '--exec_target', + help="Name of executable to build. Fails if more than one program is " + "found. If EXEC ends in .a then a library is built." +) +parser.add_argument( + '-e', '--link_externals', + action='store_true', + help="Always compile and link any files that do not produce modules " + "(externals)." +) +parser.add_argument( + '-d', '--debug', + action='store_true', + help="Annotate the makefile with extra information." +) args = parser.parse_args() # Do the thing -create_deps(args.path, args.makefile, args.debug, args.exec_target, args.fc_rule, args.link_externals, sys.argv[0]) +create_deps(args.path, args.makefile, args.debug, args.exec_target, + args.fc_rule, args.link_externals, sys.argv[0]) From 8f7b1fb8a9b8c682fc83fe7f1091d71cef5d0d9b Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 9 Dec 2022 10:33:48 -0500 Subject: [PATCH 045/213] makedep: Include C derived object files in list of "externals" Applying makedep to a single shot build of FMS+MOM6 (i.e. skipping the libFMS.a) I found the list of objects was incomplete because the C files were not covered by the module dependencies. makedep figures out the Fortran module dependencies and then has a list of "externals" to cover all the files that don't provide modules. "externals" are always compiled, in lieu of flinting the source code. This commit simply adds all the C object files to the list of externals. When building a library, the module dependencies are ignore and everything gets built, which is why this gap was not seen before. --- ac/makedep | 1 + 1 file changed, 1 insertion(+) diff --git a/ac/makedep b/ac/makedep index d201b49ab2..829928626b 100755 --- a/ac/makedep +++ b/ac/makedep @@ -92,6 +92,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, _, _, cpp, inc, _ = scan_fortran_file(f) # maps object file to .h files included o2h[object_file(f)] = cpp + externals.append(object_file(f)) # Are we building a library, single or multiple executables? targ_libs = [] From 9bc8772afb4c8a11a829c351824dfd431d7a14ce Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 9 Dec 2022 14:05:37 -0500 Subject: [PATCH 046/213] makedep: PEP8 cleanup Fixes all remaining PEP8 violations in ac/makedep (using line length = 132). --- ac/makedep | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/ac/makedep b/ac/makedep index 829928626b..5954f1aae5 100755 --- a/ac/makedep +++ b/ac/makedep @@ -74,14 +74,14 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, if prg: for p in prg: if p in prg2o.keys(): - #raise ValueError("Files %s and %s both create the same program '%s'"%( + # raise ValueError("Files %s and %s both create the same program '%s'"%( # f,o2F90[prg2o[p]],p)) print("Warning: Files {} and {} both create the same " "program '{}'".format(f, o2F90[prg2o[p]], p)) o = prg2o[p] del prg2o[p] - #del o2prg[o] - need to keep so modifying instead - o2prg[o] = ['[ignored %s]'%(p)] + # del o2prg[o] - need to keep so modifying instead + o2prg[o] = ['[ignored %s]' % (p)] else: prg2o[p] = object_file(f) if not mods and not prg: @@ -117,7 +117,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, # Create new makefile with open(makefile, 'w') as file: - print("# %s created by makedep"%(makefile), file=file) + print("# %s created by makedep" % (makefile), file=file) print("", file=file) print("# Invoked as", file=file) print('# '+' '.join(sys.argv), file=file) @@ -125,13 +125,13 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, print("all:", " ".join(targets), file=file) print("", file=file) - #print("# SRC_DIRS is usually set in the parent Makefile but in case is it not we", file=file) - #print("# record it here from when makedep was previously invoked.", file=file) - #print("SRC_DIRS ?= ${SRC_DIRS}", file=file) - #print("", file=file) + # print("# SRC_DIRS is usually set in the parent Makefile but in case is it not we", file=file) + # print("# record it here from when makedep was previously invoked.", file=file) + # print("SRC_DIRS ?= ${SRC_DIRS}", file=file) + # print("", file=file) - #print("# all_files:", ' '.join(all_files), file=file) - #print("", file=file) + # print("# all_files:", ' '.join(all_files), file=file) + # print("", file=file) # Write rule for each object from Fortran for o in sorted(o2F90.keys()): @@ -152,7 +152,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, print("# incargs:", ' '.join(incargs), file=file) print("# program:", ' '.join(o2prg[o]), file=file) if o2mods[o]: - print(' '.join(o2mods[o])+':',o, file=file) + print(' '.join(o2mods[o])+':', o, file=file) print(o + ':', o2F90[o], ' '.join(incdeps+found_mods), file=file) print('\t'+fc_rule, ' '.join(incargs), file=file) @@ -161,7 +161,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, incdeps = sorted(set([f2F[h] for h in o2h[o] if h in f2F])) incargs = sorted(set(['-I'+os.path.dirname(f) for f in incdeps])) if debug: - print("# Source file %s produces:"%(o2c[o]), file=file) + print("# Source file %s produces:" % (o2c[o]), file=file) print("# object:", o, file=file) print("# includes_all:", ' '.join(o2h[o]), file=file) print("# includes_pth:", ' '.join(incdeps), file=file) @@ -183,13 +183,13 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, for p in sorted(prg2o.keys()): o = prg2o[p] print("", file=file) - print(p+':',' '.join(link_obj(o, o2uses, mod2o, all_modules) + externals), file=file) + print(p+':', ' '.join(link_obj(o, o2uses, mod2o, all_modules) + externals), file=file) print('\t$(LD) $(LDFLAGS) -o $@ $^ $(LIBS)', file=file) # Write rules for building libraries - for l in sorted(targ_libs): + for lb in sorted(targ_libs): print("", file=file) - print(l+':',' '.join(list(o2F90.keys()) + list(o2c.keys())), file=file) + print(lb+':', ' '.join(list(o2F90.keys()) + list(o2c.keys())), file=file) print('\t$(AR) $(ARFLAGS) $@ $^', file=file) # Write cleanup rules @@ -211,12 +211,12 @@ def link_obj(obj, o2uses, mod2o, all_modules): else: return uses = [m for m in o2uses[obj] if m in all_modules] - if len(uses)>0: + if len(uses) > 0: ouses = [mod2o[m] for m in uses] for m in uses: o = mod2o[m] recur(o, depth=depth+1) - #if o not in olst: + # if o not in olst: # recur(o, depth=depth+1) # olst.append(o) return @@ -271,7 +271,7 @@ def scan_fortran_file(src_file): programs.append(match.group(1)) used_modules = [m for m in sorted(set(used_modules)) if m not in module_decl] return add_suff(module_decl, '.mod'), add_suff(used_modules, '.mod'), cpp_includes, f90_includes, programs - #return add_suff(module_decl, '.mod'), add_suff(sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs + # return add_suff(module_decl, '.mod'), add_suff(sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs def object_file(src_file): From 3327037b03e7d4e9c235c986e9935eab0bebd491 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 24 Nov 2022 08:22:20 -0500 Subject: [PATCH 047/213] Document units in 8 lat_param or diag modules Documented numerous internal variables and their units in 3 lateral parameterization modules (MOM_hor_visc, MOM_lateral_mixing_coeffs, MOM_MEKE_types) and the write_cputime module. In addition, the units of a number of internal variables in the MOM_sum_output module and arguments to call_tracer_stocks were added to their descriptions in comments. This commit includes the addition of units arguments in 9 unlogged get_param calls, comments describing why parameters are not rescaled, and the rescaling of MAXVEL in hor_visc_init. A number of spelling errors were also corrected in comments. All answers and output are bitwise identical. --- src/core/MOM_barotropic.F90 | 6 +- src/diagnostics/MOM_sum_output.F90 | 71 +++++------ src/framework/MOM_write_cputime.F90 | 27 +++-- .../testing/MOM_file_parser_tests.F90 | 8 +- .../lateral/MOM_MEKE_types.F90 | 4 +- .../lateral/MOM_hor_visc.F90 | 111 ++++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 74 +++++++----- src/tracer/MOM_tracer_flow_control.F90 | 36 +++--- 8 files changed, 184 insertions(+), 153 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 44711e6526..5fd8a97793 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4614,6 +4614,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "gravity waves) to 1 (for a backward Euler treatment). "//& "In practice, BEBT must be greater than about 0.05.", & units="nondim", default=0.1) + ! Note that dtbt_input is not rescaled because it has different units for + ! positive [s] and negative [nondim] values. call get_param(param_file, mdl, "DTBT", dtbt_input, & "The barotropic time step, in s. DTBT is only used with "//& "the split explicit time stepping. To set the time step "//& @@ -4621,8 +4623,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "a negative value gives the fraction of the stable value. "//& "Setting DTBT to 0 is the same as setting it to -0.98. "//& "The value of DTBT that will actually be used is an "//& - "integer fraction of DT, rounding down.", units="s or nondim",& - default = -0.98) + "integer fraction of DT, rounding down.", & + units="s or nondim", default=-0.98) call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", & CS%use_old_coriolis_bracket_bug , & "If True, use an order of operations that is not bitwise "//& diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 4eb1e67e96..7797a266dd 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -4,6 +4,7 @@ module MOM_sum_output ! This file is part of MOM6. See LICENSE.md for the license. use iso_fortran_env, only : int64 +use MOM_checksums, only : is_NaN use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs @@ -108,14 +109,16 @@ module MOM_sum_output !! of calls to write_energy and revert to the standard !! energysavedays interval - real :: timeunit !< The length of the units for the time axis [s]. + real :: timeunit !< The length of the units for the time axis and certain input parameters + !! including ENERGYSAVEDAYS [s]. + logical :: date_stamped_output !< If true, use dates (not times) in messages to stdout. type(time_type) :: Start_time !< The start time of the simulation. ! Start_time is set in MOM_initialization.F90 integer, pointer :: ntrunc => NULL() !< The number of times the velocity has been !! truncated since the last call to write_energy. real :: max_Energy !< The maximum permitted energy per unit mass. If there is - !! more energy than this, the model should stop [m2 s-2]. + !! more energy than this, the model should stop [L2 T-2 ~> m2 s-2]. integer :: maxtrunc !< The number of truncations per energy save !! interval at which the run is stopped. logical :: write_stocks !< If true, write the integrated tracer amounts @@ -147,13 +150,12 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. ! Local variables - real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS [s] - real :: maxvel ! The maximum permitted velocity [m s-1] + real :: maxvel ! The maximum permitted velocity [L T-1 ~> m s-1] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_sum_output" ! This module's name. character(len=200) :: energyfile ! The name of the energy file. - character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs + character(len=32) :: filename_appendix = '' ! FMS appendix to filename for ensemble runs if (associated(CS)) then call MOM_error(WARNING, "MOM_sum_output_init called with associated control structure.") @@ -190,13 +192,13 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & "The maximum permitted average energy per unit mass; the "//& "model will be stopped if there is more energy than "//& "this. If zero or negative, this is set to 10*MAXVEL^2.", & - units="m2 s-2", default=0.0) + units="m2 s-2", default=0.0, scale=US%m_s_to_L_T**2) if (CS%max_Energy <= 0.0) then call get_param(param_file, mdl, "MAXVEL", maxvel, & "The maximum velocity allowed before the velocity "//& - "components are truncated.", units="m s-1", default=3.0e8) + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) CS%max_Energy = 10.0 * maxvel**2 - call log_param(param_file, mdl, "MAX_ENERGY as used", CS%max_Energy) + call log_param(param_file, mdl, "MAX_ENERGY as used", US%L_T_to_m_s**2*CS%max_Energy, units="m2 s-2") endif call get_param(param_file, mdl, "ENERGYFILE", energyfile, & @@ -218,13 +220,12 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & call get_param(param_file, mdl, "DATE_STAMPED_STDOUT", CS%date_stamped_output, & "If true, use dates (not times) in messages to stdout", & default=.true.) + ! Note that the units of CS%Timeunit are the MKS units of [s]. call get_param(param_file, mdl, "TIMEUNIT", CS%Timeunit, & "The time unit in seconds a number of input fields", & units="s", default=86400.0) if (CS%Timeunit < 0.0) CS%Timeunit = 86400.0 - - if (CS%do_APE_calc) then call get_param(param_file, mdl, "READ_DEPTH_LIST", CS%read_depth_list, & "Read the depth list from a file if it exists or "//& @@ -257,18 +258,15 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & CS%DL%listsize = 1 endif - call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & - "The time unit for ENERGYSAVEDAYS.", & - units="s", default=86400.0) call get_param(param_file, mdl, "ENERGYSAVEDAYS",CS%energysavedays, & "The interval in units of TIMEUNIT between saves of the "//& "energies of the run and other globally summed diagnostics.",& - default=set_time(0,days=1), timeunit=Time_unit) + default=set_time(0,days=1), timeunit=CS%Timeunit) call get_param(param_file, mdl, "ENERGYSAVEDAYS_GEOMETRIC",CS%energysavedays_geometric, & "The starting interval in units of TIMEUNIT for the first call "//& "to save the energies of the run and other globally summed diagnostics. "//& "The interval increases by a factor of 2. after each call to write_energy.",& - default=set_time(seconds=0), timeunit=Time_unit) + default=set_time(seconds=0), timeunit=CS%Timeunit) if ((time_type_to_real(CS%energysavedays_geometric) > 0.) .and. & (CS%energysavedays_geometric < CS%energysavedays)) then @@ -328,7 +326,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci real :: PE_tot ! The total available potential energy [J]. real :: Z_0APE(SZK_(GV)+1) ! The uniform depth which overlies the same ! volume as is below an interface [Z ~> m]. - real :: H_0APE(SZK_(GV)+1) ! A version of Z_0APE, converted to m, usually positive. + real :: H_0APE(SZK_(GV)+1) ! A version of Z_0APE, converted to m, usually positive [m]. real :: toten ! The total kinetic & potential energies of ! all layers [J] (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by @@ -381,7 +379,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci real :: CFL_lin ! A simpler definition of the CFL number [nondim]. real :: max_CFL(2) ! The maxima of the CFL numbers [nondim]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - tmp1 ! A temporary array + tmp1 ! A temporary array used in reproducing sums [various] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & PE_pt ! The potential energy at each point [J]. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -398,21 +396,26 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci ! lbelow & labove are lower & upper limits for li ! in the search for the entry in lH to use. integer :: start_of_day, num_days - real :: reday, var + real :: reday ! Time in units given by CS%Timeunit, but often [days] character(len=240) :: energypath_nc character(len=200) :: mesg character(len=32) :: mesg_intro, time_units, day_str, n_str, date_str logical :: date_stamped type(time_type) :: dt_force ! A time_type version of the forcing timestep. - real :: Tr_stocks(MAX_FIELDS_) ! The total amounts of each of the registered tracers - real :: Tr_min(MAX_FIELDS_) ! The global minimum unmasked value of the tracers - real :: Tr_max(MAX_FIELDS_) ! The global maximum unmasked value of the tracers + ! The units of the tracer stock vary between tracers, with [conc] given explicitly by Tr_units. + real :: Tr_stocks(MAX_FIELDS_) ! The total amounts of each of the registered tracers [kg conc] + real :: Tr_min(MAX_FIELDS_) ! The global minimum unmasked value of the tracers [conc] + real :: Tr_max(MAX_FIELDS_) ! The global maximum unmasked value of the tracers [conc] real :: Tr_min_x(MAX_FIELDS_) ! The x-positions of the global tracer minima + ! in the units of G%geoLonT, often [degrees_E] or [km] real :: Tr_min_y(MAX_FIELDS_) ! The y-positions of the global tracer minima - real :: Tr_min_z(MAX_FIELDS_) ! The z-positions of the global tracer minima + ! in the units of G%geoLatT, often [degrees_N] or [km] + real :: Tr_min_z(MAX_FIELDS_) ! The z-positions of the global tracer minima [layer] real :: Tr_max_x(MAX_FIELDS_) ! The x-positions of the global tracer maxima + ! in the units of G%geoLonT, often [degrees_E] or [km] real :: Tr_max_y(MAX_FIELDS_) ! The y-positions of the global tracer maxima - real :: Tr_max_z(MAX_FIELDS_) ! The z-positions of the global tracer maxima + ! in the units of G%geoLatT, often [degrees_N] or [km] + real :: Tr_max_z(MAX_FIELDS_) ! The z-positions of the global tracer maxima [layer] logical :: Tr_minmax_avail(MAX_FIELDS_) ! A flag indicating whether the global minimum and ! maximum information are available for each of the tracers character(len=40), dimension(MAX_FIELDS_) :: & @@ -860,8 +863,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci endif endif - var = real(CS%ntrunc) - call write_field(CS%fileenergy_nc, CS%fields(1), var, reday) + call write_field(CS%fileenergy_nc, CS%fields(1), real(CS%ntrunc), reday) call write_field(CS%fileenergy_nc, CS%fields(2), toten, reday) call write_field(CS%fileenergy_nc, CS%fields(3), PE, reday) call write_field(CS%fileenergy_nc, CS%fields(4), KE, reday) @@ -891,13 +893,12 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci call flush_file(CS%fileenergy_nc) - ! The second (impossible-looking) test looks for a NaN in En_mass. - if ((En_mass>CS%max_Energy) .or. & - ((En_mass>CS%max_Energy) .and. (En_mass US%L_T_to_m_s**2*CS%max_Energy) then write(mesg,'("Energy per unit mass of ",ES11.4," exceeds ",ES11.4)') & - En_mass, CS%max_Energy - call MOM_error(FATAL, & - "write_energy : Excessive energy per unit mass or NaNs forced model termination.") + En_mass, US%L_T_to_m_s**2*CS%max_Energy + call MOM_error(FATAL, "write_energy : Excessive energy per unit mass forced model termination.") endif if (CS%ntrunc>CS%maxtrunc) then call MOM_error(FATAL, "write_energy : Ocean velocity has been truncated too many times.") @@ -913,7 +914,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci end subroutine write_energy -!> This subroutine accumates the net input of volume, salt and heat, through +!> This subroutine accumulates the net input of volume, salt and heat, through !! the ocean surface for use in diagnosing conservation. subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible @@ -1100,7 +1101,7 @@ end subroutine depth_list_setup subroutine create_depth_list(G, DL, min_depth_inc) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Depth_List), intent(inout) :: DL !< The list of depths, areas and volumes to create - real, intent(in) :: min_depth_inc !< The minimum increment bewteen depths in the list [Z ~> m] + real, intent(in) :: min_depth_inc !< The minimum increment between depths in the list [Z ~> m] ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & @@ -1110,7 +1111,7 @@ subroutine create_depth_list(G, DL, min_depth_inc) indx2 !< The position of an element in the original unsorted list. real :: Dnow !< The depth now being considered for sorting [Z ~> m]. real :: Dprev !< The most recent depth that was considered [Z ~> m]. - real :: vol !< The running sum of open volume below a deptn [Z L2 ~> m3]. + real :: vol !< The running sum of open volume below a depth [Z L2 ~> m3]. real :: area !< The open area at the current depth [L2 ~> m2]. real :: D_list_prev !< The most recent depth added to the list [Z ~> m]. logical :: add_to_list !< This depth should be included as an entry on the list. @@ -1360,7 +1361,7 @@ subroutine get_depth_list_checksums(G, US, depth_chksum, area_chksum) character(len=16), intent(out) :: area_chksum !< Area checksum hexstring integer :: i, j - real, allocatable :: field(:,:) + real, allocatable :: field(:,:) ! A temporary array for output converted to MKS units [m] or [m2] allocate(field(G%isc:G%iec, G%jsc:G%jec)) diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index 5277cef1f6..025dcad2ac 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -21,17 +21,17 @@ module MOM_write_cputime !> A control structure that regulates the writing of CPU time type, public :: write_cputime_CS ; private logical :: initialized = .false. !< True if this control structure has been initialized. - real :: maxcpu !< The maximum amount of cpu time per processor + real :: maxcpu !< The maximum amount of CPU time per processor !! for which MOM should run before saving a restart - !! file and quiting with a return value that + !! file and quitting with a return value that !! indicates that further execution is required to - !! complete the simulation, in wall-clock seconds. + !! complete the simulation [wall-clock seconds]. type(time_type) :: Start_time !< The start time of the simulation. !! Start_time is set in MOM_initialization.F90 - real :: startup_cputime !< The CPU time used in the startup phase of the model. - real :: prev_cputime = 0.0 !< The last measured CPU time. - real :: dn_dcpu_min = -1.0 !< The minimum derivative of timestep with CPU time. - real :: cputime2 = 0.0 !< The accumulated cpu time. + real :: startup_cputime !< The CPU time used in the startup phase of the model [clock_cycles]. + real :: prev_cputime = 0.0 !< The last measured CPU time [clock_cycles]. + real :: dn_dcpu_min = -1.0 !< The minimum derivative of timestep with CPU time [steps clock_cycles-1]. + real :: cputime2 = 0.0 !< The accumulated CPU time [clock_cycles]. integer :: previous_calls = 0 !< The number of times write_CPUtime has been called. integer :: prev_n = 0 !< The value of n from the last call. integer :: fileCPU_ascii= -1 !< The unit number of the CPU time file. @@ -76,8 +76,8 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) ! Read all relevant parameters and write them to the model log. - ! Determine whether all paramters are set to their default values. - call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, default=-1.0, do_not_log=.true.) + ! Determine whether all parameters are set to their default values. + call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, units="wall-clock seconds", default=-1.0, do_not_log=.true.) call get_param(param_file, mdl, "CPU_TIME_FILE", CS%CPUfile, default="CPU_stats", do_not_log=.true.) all_default = (CS%maxcpu == -1.0) .and. (trim(CS%CPUfile) == trim("CPU_stats")) @@ -135,10 +135,11 @@ subroutine write_cputime(day, n, CS, nmax, call_end) ! Local variables real :: d_cputime ! The change in CPU time since the last call - ! this subroutine. - integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK - real :: reday ! A real version of day. - integer :: start_of_day, num_days + ! this subroutine [clock_cycles] + integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK [clock_cycles] + real :: reday ! The time in days, including fractional days [days] + integer :: start_of_day ! The number of seconds since the start of the day + integer :: num_days ! The number of days in the time if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") diff --git a/src/framework/testing/MOM_file_parser_tests.F90 b/src/framework/testing/MOM_file_parser_tests.F90 index 5ad90caf1b..673cef8c16 100644 --- a/src/framework/testing/MOM_file_parser_tests.F90 +++ b/src/framework/testing/MOM_file_parser_tests.F90 @@ -1468,7 +1468,7 @@ subroutine test_get_param_real call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample) + call get_param(param, module_name, sample_param_name, sample, units="") call close_param_file(param) end subroutine test_get_param_real @@ -1480,7 +1480,7 @@ subroutine test_get_param_real_no_read_no_log call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample, & + call get_param(param, module_name, sample_param_name, sample, units="", & do_not_read=.true., do_not_log=.true.) call close_param_file(param) end subroutine test_get_param_real_no_read_no_log @@ -1493,7 +1493,7 @@ subroutine test_get_param_real_array call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample) + call get_param(param, module_name, sample_param_name, sample, units="") call close_param_file(param) end subroutine test_get_param_real_array @@ -1505,7 +1505,7 @@ subroutine test_get_param_real_array_no_read_no_log call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample, & + call get_param(param, module_name, sample_param_name, sample, units="", & do_not_read=.true., do_not_log=.true.) call close_param_file(param) end subroutine test_get_param_real_array_no_read_no_log diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 57de7c0b02..e51f558ce3 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -26,8 +26,8 @@ module MOM_MEKE_types ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. - real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter. - real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter. + real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter [nondim]. + real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter [nondim]. end type MEKE_type diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index d118f625bf..0574297c0c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -52,7 +52,7 @@ module MOM_hor_visc logical :: better_bound_Ah !< If true, use a more careful bounding of the !! biharmonic viscosity to guarantee stability. real :: Re_Ah !! If nonzero, the biharmonic coefficient is scaled - !< so that the biharmonic Reynolds number is equal to this. + !< so that the biharmonic Reynolds number is equal to this [nondim]. real :: bound_coef !< The nondimensional coefficient of the ratio of !! the viscosity bounds to the theoretical maximum !! for stability without considering other terms [nondim]. @@ -123,8 +123,8 @@ module MOM_hor_visc real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. - n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points - n1n1_m_n2n2_h, & !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points + n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points [nondim] + n1n1_m_n2n2_h, & !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points [nondim] grid_sp_h2, & !< Harmonic mean of the squares of the grid [L2 ~> m2] grid_sp_h3 !< Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy @@ -141,8 +141,8 @@ module MOM_hor_visc real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. - n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points - n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points + n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points [nondim] + n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points [nondim] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] @@ -181,8 +181,10 @@ module MOM_hor_visc type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics - ! real, allocatable :: hf_diffu(:,:,:) ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, allocatable :: hf_diffv(:,:,:) ! Meridional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffu(:,:,:) ! Zonal horizontal viscous acceleleration times + ! ! fractional thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffv(:,:,:) ! Meridional horizontal viscous acceleleration times + ! ! fractional thickness [L T-2 ~> m s-2]. ! 3D diagnostics 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. @@ -242,12 +244,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! related to Mesoscale Eddy Kinetic Energy. - type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct + type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control structure type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type - type(barotropic_CS), intent(in), optional :: BT !< Barotropic control struct - type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control struct + type(barotropic_CS), intent(in), optional :: BT !< Barotropic control structure + type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control structure type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics ! Local variables @@ -256,20 +258,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] + ubtav ! zonal barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & Del2v, & ! The v-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] + vbtav ! meridional barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] - str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] - str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2], but + ! at some points in the code it is not yet layer integrated, so is in [L2 T-2 ~> m2 s-2]. + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [L2 T-2 ~> m2 s-2] bhstr_xx, & ! A copy of str_xx that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [R L2 T-3 ~> W m-2] grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] @@ -288,8 +291,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 ~> s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] - str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] - str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2], but + ! at some points in the code it is not yet layer integrated, so is in [L2 T-2 ~> m2 s-2]. + str_xy_GME, & ! smoothed cross term in the stress tensor from GME [L2 T-2 ~> m2 s-2] bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] @@ -310,9 +314,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, GME_coeff_q, & !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] ShSt ! A diagnostic array of shear stress [T-1 ~> s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & - KH_u_GME !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_u_GME !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & - KH_v_GME !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + KH_v_GME !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] @@ -324,7 +328,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & grid_Re_Kh, & ! Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] grid_Re_Ah, & ! Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] - GME_coeff_h ! GME coeff. at h-points [L2 T-1 ~> m2 s-1] + GME_coeff_h ! GME coefficient at h-points [L2 T-1 ~> m2 s-1] real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Shear_mag_bc ! Shear_mag value in backscatter [T-1 ~> s-1] @@ -342,7 +346,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: RoScl ! The scaling function for MEKE source term [nondim] real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] real :: local_strain ! Local variable for interpolating computed strain rates [T-1 ~> s-1]. - real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. + real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE [nondim]. Otherwise = 1. real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] real :: DX_dyBu ! Ratio of zonal over meridional grid spacing at vertices [nondim] @@ -352,7 +356,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: KE ! Local kinetic energy [L2 T-2 ~> m2 s-2] real :: d_del2u ! dy-weighted Laplacian(u) diff in x [L-2 T-1 ~> m-2 s-1] real :: d_del2v ! dx-weighted Laplacian(v) diff in y [L-2 T-1 ~> m-2 s-1] - real :: d_str ! Stress tensor update [H L2 T-2 ~> m3 s-2 or kg s-2] + real :: d_str ! Stress tensor update [L2 T-2 ~> m2 s-2] real :: grad_vort ! Vorticity gradient magnitude [L-1 T-1 ~> m-1 s-1] real :: grad_vort_qg ! QG-based vorticity gradient magnitude [L-1 T-1 ~> m-1 s-1] real :: grid_Kh ! Laplacian viscosity bound by grid [L2 T-1 ~> m2 s-1] @@ -365,7 +369,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n - real :: inv_PI3, inv_PI2, inv_PI6 + real :: inv_PI3, inv_PI2, inv_PI6 ! Powers of the inverse of pi [nondim] ! Fields evaluated on active layers, used for constructing 3D stress fields ! NOTE: The position of these declarations can impact performance, due to the @@ -419,7 +423,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((rescale_Kh .or. CS%res_scale_MEKE) & .and. (.not. allocated(VarMix%Res_fn_h) .or. .not. allocated(VarMix%Res_fn_q))) & call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and VarMix%Res_fn_q "//& - "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") + "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") elseif (CS%res_scale_MEKE) then call MOM_error(FATAL, "MOM_hor_visc: VarMix needs to be associated if "//& "RES_SCALE_MEKE_VISC is True.") @@ -430,7 +434,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%use_GME) then - ! initialize diag. array with zeros + ! Initialize diagnostic arrays with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 str_xx_GME(:,:) = 0.0 @@ -1418,11 +1422,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call smooth_GME(CS, G, GME_flux_h=str_xx_GME) call smooth_GME(CS, G, GME_flux_q=str_xy_GME) + ! This changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo - ! GME is applied below + ! This adds in GME and changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. if (CS%no_slip) then do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * CS%reduction_xy(I,J)) @@ -1434,10 +1439,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif else ! .not. use_GME + ! This changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo + ! This changes the units of str_xy from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. if (CS%no_slip) then do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = str_xy(I,J) * (hq(I,J) * CS%reduction_xy(I,J)) @@ -1685,10 +1692,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics - real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v - real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v - ! u0v is the Laplacian sensitivities to the v velocities - ! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly. + ! u0v is the Laplacian sensitivities to the v velocities at u points, with u0u, v0u, and v0v defined analogously. + real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v ! Laplacian sensitivities at u points [L-2 ~> m-2] + real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! Laplacian sensitivities at v points [L-2 ~> m-2] real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [L2 ~> m2] real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] real :: grid_sp_q2 ! spacings at h and q points [L2 ~> m2] @@ -1708,19 +1714,19 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Laplacian viscosity real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives biharmonic viscosity real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] - real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant - real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant - real :: Leith_Lap_const ! nondimensional Laplacian Leith constant - real :: Leith_bi_const ! nondimensional biharmonic Leith constant + real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant [nondim] + real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant [nondim] + real :: Leith_Lap_const ! nondimensional Laplacian Leith constant [nondim] + real :: Leith_bi_const ! nondimensional biharmonic Leith constant [nondim] real :: dt ! The dynamics time step [T ~> s] real :: Idt ! The inverse of dt [T-1 ~> s-1] - real :: denom ! work variable; the denominator of a fraction - real :: maxvel ! largest permitted velocity components [m s-1] + real :: denom ! work variable; the denominator of a fraction [L-2 ~> m-2] or [L-4 ~> m-4] + real :: maxvel ! largest permitted velocity components [L T-1 ~> m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration [L T-1 ~> m s-1] real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] - real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat + real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat [nondim] logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. @@ -1732,9 +1738,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags character(len=200) :: inputdir, filename ! Input file names and paths character(len=80) :: Kh_var ! Input variable names - real :: deg2rad ! Converts degrees to radians - real :: slat_fn ! sin(lat)**Kh_pwr_of_sine - real :: aniso_grid_dir(2) ! Vector (n1,n2) for anisotropic direction + real :: deg2rad ! Converts degrees to radians [radians degree-1] + real :: slat_fn ! sin(lat)**Kh_pwr_of_sine [nondim] + real :: aniso_grid_dir(2) ! Vector (n1,n2) for anisotropic direction [nondim] integer :: aniso_mode ! Selects the mode for setting the anisotropic direction integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -1945,12 +1951,13 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def, & do_not_log=.not.CS%Smagorinsky_Ah) if (.not.CS%Smagorinsky_Ah) CS%bound_Coriolis = .false. - call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) + call get_param(param_file, mdl, "MAXVEL", maxvel, & + units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & "The velocity scale at which BOUND_CORIOLIS_BIHARM causes "//& "the biharmonic drag to have comparable magnitude to the "//& "Coriolis acceleration. The default is set by MAXVEL.", & - units="m s-1", default=maxvel, scale=US%m_s_to_L_T, & + units="m s-1", default=maxvel*US%L_T_to_m_s, scale=US%m_s_to_L_T, & do_not_log=.not.(CS%Smagorinsky_Ah .and. CS%bound_Coriolis)) call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & @@ -2229,8 +2236,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 - ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires - ! this to be less than 1/3, rather than 1/2 as before. + ! The 0.3 below was 0.4 in HIM 1.10. The change in hq requires + ! this to be less than 1/3, rather than 1/2 as before. if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (dt*64.0) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) @@ -2533,10 +2540,10 @@ subroutine align_aniso_tensor_to_grid(CS, n1, n2) real, intent(in) :: n1 !< i-component of direction vector [nondim] real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables - real :: recip_n2_norm + real :: recip_n2_norm ! The inverse of the squared magnitude of n1 and n2 [nondim] ! For normalizing n=(n1,n2) in case arguments are not a unit vector recip_n2_norm = n1**2 + n2**2 - if (recip_n2_norm > 0.) recip_n2_norm = 1./recip_n2_norm + if (recip_n2_norm > 0.) recip_n2_norm = 1. / recip_n2_norm CS%n1n2_h(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm CS%n1n2_q(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm CS%n1n1_m_n2n2_h(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm @@ -2549,13 +2556,13 @@ subroutine smooth_GME(CS, G, GME_flux_h, GME_flux_q) type(hor_visc_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< GME diffusive flux - !! at h points + !! at h points [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: GME_flux_q!< GME diffusive flux - !! at q points + !! at q points [L2 T-2 ~> m2 s-2] ! local variables - real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original - real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original - real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original ! The previous value of GME_flux_h [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original ! The previous value of GME_flux_q [L2 T-2 ~> m2 s-2] + real :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] integer :: i, j, s, halosz integer :: xh, xq ! The number of valid extra halo points for h and q points. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -2618,7 +2625,7 @@ end subroutine smooth_GME !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) - type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure if (CS%Laplacian .or. CS%biharmonic) then DEALLOC_(CS%dx2h) ; DEALLOC_(CS%dx2q) ; DEALLOC_(CS%dy2h) ; DEALLOC_(CS%dy2q) DEALLOC_(CS%dx_dyT) ; DEALLOC_(CS%dy_dxT) ; DEALLOC_(CS%dx_dyBu) ; DEALLOC_(CS%dy_dxBu) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 50ddd224ed..47d1cd6eb3 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -120,12 +120,13 @@ module MOM_lateral_mixing_coeffs ! Parameters logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity integer :: VarMix_Ktop !< Top layer to start downward integrals - real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula + real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula [L ~> m], or if negative a scaling + !! factor [nondim] relating this length scale squared to the cell area real :: Eady_GR_D_scale !< Depth over which to average SN [Z ~> m] - real :: Res_coef_khth !< A non-dimensional number that determines the function + real :: Res_coef_khth !< A coefficient [nondim] that determines the function !! of resolution, used for thickness and tracer mixing, as: !! F = 1 / (1 + (Res_coef_khth*Ld/dx)^Res_fn_power) - real :: Res_coef_visc !< A non-dimensional number that determines the function + real :: Res_coef_visc !< A coefficient [nondim] that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) real :: depth_scaled_khth_h0 !< The depth above which KHTH is linearly scaled away [Z ~> m] @@ -167,13 +168,13 @@ module MOM_lateral_mixing_coeffs !> Calculates the non-dimensional depth functions. subroutine calc_depth_function(G, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: i, j - real :: H0 ! local variable for reference depth - real :: expo ! exponent used in the depth dependent scaling + real :: H0 ! The depth above which KHTH is linearly scaled away [Z ~> m] + real :: expo ! exponent used in the depth dependent scaling [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -186,6 +187,7 @@ subroutine calc_depth_function(G, CS) if (.not. allocated(CS%Depth_fn_v)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_v is not associated with Depth_scaled_KhTh.") + ! For efficiency, the reciprocal of H0 should be used instead. H0 = CS%depth_scaled_khth_h0 expo = CS%depth_scaled_khth_exp !$OMP do @@ -206,7 +208,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some @@ -454,8 +456,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment [T ~> s] - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure ! Local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. @@ -511,27 +513,30 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency !! at u-points [L2 Z-2 T-2 ~> s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: slope_y !< Meridional isoneutral slope + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: slope_y !< Meridional isoneutral slope [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables real :: S2 ! Interface slope squared [nondim] real :: N2 ! Positive buoyancy frequency or zero [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] - real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - integer :: is, ie, js, je, nz - integer :: i, j, k - integer :: l_seg - real :: S2max, wNE, wSE, wSW, wNW - real :: H_u(SZIB_(G)), H_v(SZI_(G)) - real :: S2_u(SZIB_(G), SZJ_(G)) - real :: S2_v(SZI_(G), SZJB_(G)) + real :: H_geom ! The geometric mean of Hup and Hdn [H ~> m or kg m-2]. + real :: S2max ! An upper bound on the squared slopes [nondim] + real :: wNE, wSE, wSW, wNW ! Weights of adjacent points [nondim] + real :: H_u(SZIB_(G)), H_v(SZI_(G)) ! Layer thicknesses at u- and v-points [H ~> m or kg m-2] + + ! Note that at some points in the code S2_u and S2_v hold the running depth + ! integrals of the squared slope [H ~> m or kg m-2] before the average is taken. + real :: S2_u(SZIB_(G),SZJ_(G)) ! The thickness-weighted depth average of the squared slope at u points [nondim]. + real :: S2_v(SZI_(G),SZJB_(G)) ! The thickness-weighted depth average of the squared slope at v points [nondim]. + + integer :: i, j, k, is, ie, js, je, nz, l_seg if (.not. CS%initialized) call MOM_error(FATAL, "calc_Visbeck_coeffs_old: "// & "Module must be initialized before it is used.") @@ -628,7 +633,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C enddo enddo -! Offer diagnostic fields for averaging. + ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag) if (CS%id_S2_v > 0) call post_data(CS%id_S2_v, S2_v, CS%diag) @@ -667,7 +672,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, real :: sum_dz(SZI_(G)) ! Cumulative sum of z-thicknesses [Z ~> m] real :: vint_SN(SZIB_(G)) ! Cumulative integral of SN [Z T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G)) :: SN_cpy !< SN at u-points [T-1 ~> s-1] - real :: dz_neglect ! An incy wincy distance to avoid division by zero [Z ~> m] + real :: dz_neglect ! A negligibly small distance to avoid division by zero [Z ~> m] real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~> m-1] real :: dB, dT ! Elevation variables used when cropping [Z ~> m] integer :: i, j, k, l_seg @@ -805,13 +810,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes !! internally otherwise use slopes stored in CS ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) + real :: E_x(SZIB_(G),SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) + real :: E_y(SZI_(G),SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -820,11 +825,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. + real :: S2N2_u_local(SZIB_(G),SZJ_(G),SZK_(GV)) ! The depth integral of the slope times + ! the buoyancy frequency squared at u-points [Z T-2 ~> m s-2] + real :: S2N2_v_local(SZI_(G),SZJB_(G),SZK_(GV)) ! The depth integral of the slope times + ! the buoyancy frequency squared at v-points [Z T-2 ~> m s-2] integer :: is, ie, js, je, nz integer :: i, j, k integer :: l_seg - real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(GV)) - real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) if (.not. CS%initialized) call MOM_error(FATAL, "calc_slope_functions_using_just_e: "// & "Module must be initialized before it is used.") @@ -970,14 +977,14 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo real :: h_at_slope_below ! The thickness below [H ~> m or kg m-2] real :: Ih ! The inverse of a combination of thicknesses [H-1 ~> m-1 or m2 kg-1] real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1] + real :: inv_PI3 ! The inverse of pi cubed [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz - real :: inv_PI3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = GV%ke - inv_PI3 = 1.0/((4.0*atan(1.0))**3) + inv_PI3 = 1.0 / ((4.0*atan(1.0))**3) if ((k > 1) .and. (k < nz)) then @@ -1076,7 +1083,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients ! Local variables - real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo + real :: KhTr_Slope_Cff ! The nondimensional coefficient in the Visbeck formula + ! for the epipycnal tracer diffusivity [nondim] + real :: KhTh_Slope_Cff ! The nondimensional coefficient in the Visbeck formula + ! for the interface depth diffusivity [nondim] + real :: oneOrTwo ! A variable that may be 1 or 2, depending on which form + ! of the equatorial deformation radius us used [nondim] real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when ! calculating the first-mode wave speed [Z ~> m] real :: KhTr_passivity_coeff ! Coefficient setting the ratio between along-isopycnal tracer @@ -1187,7 +1199,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! Indicate whether to calculate the Eady growth rate CS%calculate_Eady_growth_rate = use_MEKE .or. (KhTr_Slope_Cff>0.) .or. (KhTh_Slope_Cff>0.) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & - default=0., do_not_log=.true.) + units="nondim", default=0., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (KhTr_passivity_coeff>0.) call get_param(param_file, mdl, "MLE_FRONT_LENGTH", MLE_front_length, & units="m", default=0.0, scale=US%m_to_L, do_not_log=.true.) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index af0dded244..46001a2dc3 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -379,13 +379,14 @@ subroutine call_tracer_register_obc_segments(GV, param_file, CS, tr_Reg, OBC) call register_MOM_generic_tracer_segments(CS%MOM_generic_tracer_CSp, GV, OBC, tr_Reg, param_file) end subroutine call_tracer_register_obc_segments + !> This subroutine extracts the chlorophyll concentrations from the model state, if possible subroutine get_chl_from_model(Chl_array, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: Chl_array !< The array in which to store the model's - !! Chlorophyll-A concentrations in mg m-3. + !! Chlorophyll-A concentrations [mg m-3]. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to call_tracer_register. @@ -635,21 +636,28 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock logical, dimension(:), & optional, intent(inout) :: got_min_max !< Indicates whether the global min and !! max are found for each tracer - real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer - real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer - real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum - real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum - real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum - real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum - real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum - real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum + real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer [conc] + real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer [conc] + real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum in the + !! units of G%geoLonT, often [degrees_E] or [km] + real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum in the + !! units of G%geoLatT, often [degrees_N] or [km] + real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum [layer] + real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum in the + !! units of G%geoLonT, often [degrees_E] or [km] + real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum in the + !! units of G%geoLatT, often [degrees_N] or [km] + real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum [layer] ! Local variables character(len=200), dimension(MAX_FIELDS_) :: names, units character(len=200) :: set_pkg_name - ! real, dimension(MAX_FIELDS_) :: values - type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP - type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP + ! real, dimension(MAX_FIELDS_) :: values ! Globally integrated tracer amounts in a + ! new list for each tracer package [kg conc] + type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP ! Globally integrated tracer amounts in a + ! new list for each tracer package [kg conc] + type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP ! Globally integrated tracer amounts in a + ! single master list for all tracers [kg conc] integer :: max_ns, ns_tot, ns, index, nn, n if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_stocks: "// & @@ -758,12 +766,12 @@ subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, character(len=*), dimension(:), & intent(in) :: units !< Units to use in the metadata for each stock. type(EFP_type), dimension(:), & - intent(in) :: values !< The values of the tracer stocks + intent(in) :: values !< The values of the tracer stocks [conc kg] integer, intent(in) :: index !< The integer stock index from !! stocks_constants_mod of the stock to be returned. If this is !! present and greater than 0, only a single stock can be returned. type(EFP_type), dimension(:), & - intent(inout) :: stock_values !< The master list of stock values + intent(inout) :: stock_values !< The master list of stock values [conc kg] character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose !! stocks were stored for a specific index. This is !! used to trigger an error if there are redundant stocks. From c9334608c1f3a557e0ace7b8f710dd32f2bbdac2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 29 Nov 2022 02:24:14 -0500 Subject: [PATCH 048/213] +Add 10 units arguments to get_param calls Add units arguments to 10 get_param calls in 7 files. Also changed comments describing the various units that might be used for geoLat or geoLon variables in the ocean_grid_type to use standard syntax. The added units arguments lead to some minor differences in MOM_parameter_doc files, but all answers are bitwise identical. --- .../mct_cap/mom_surface_forcing_mct.F90 | 2 +- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 2 +- src/ALE/MOM_hybgen_regrid.F90 | 4 +- src/core/MOM_grid.F90 | 43 ++++++++++--------- src/framework/MOM_diag_mediator.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 36 ++++++++-------- src/ocean_data_assim/MOM_oda_driver.F90 | 2 +- 7 files changed, 46 insertions(+), 45 deletions(-) diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index 259aa8a678..78f7bad268 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -1119,7 +1119,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & "A factor multiplying the wind-stress given to the ocean by the "//& "coupler. This is used for testing and should be =1.0 for any "//& - "production runs.", default=1.0) + "production runs.", units="nondim", default=1.0) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 8691f564dd..738866c8ef 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -1209,7 +1209,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & "A factor multiplying the wind-stress given to the ocean by the "//& "coupler. This is used for testing and should be =1.0 for any "//& - "production runs.", default=1.0) + "production runs.", units="nondim", default=1.0) call get_param(param_file, mdl, "USE_CFC_CAP", CS%use_CFC, & default=.false., do_not_log=.true.) diff --git a/src/ALE/MOM_hybgen_regrid.F90 b/src/ALE/MOM_hybgen_regrid.F90 index cc961b88f2..271caa7ad6 100644 --- a/src/ALE/MOM_hybgen_regrid.F90 +++ b/src/ALE/MOM_hybgen_regrid.F90 @@ -172,11 +172,11 @@ subroutine init_hybgen_regrid(CS, GV, US, param_file) call get_param(param_file, mdl, "HYBGEN_REMAP_MIN_ZSTAR_DILATE", CS%min_dilate, & "The maximum amount of dilation that is permitted when converting target "//& "coordinates from z to z* [nondim]. This limit applies when drying occurs.", & - default=0.5) + units="nondim", default=0.5) call get_param(param_file, mdl, "HYBGEN_REMAP_MAX_ZSTAR_DILATE", CS%max_dilate, & "The maximum amount of dilation that is permitted when converting target "//& "coordinates from z to z* [nondim]. This limit applies when drying occurs.", & - default=2.0) + units="nondim", default=2.0) CS%onem = 1.0 * GV%m_to_H diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index f3a48f3ded..d2a0c86da8 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -75,8 +75,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. - geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. - geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. + geoLatT, & !< The geographic latitude at q points [degrees_N] or [km] or [m]. + geoLonT, & !< The geographic longitude at q points [degrees_E] or [km] or [m]. dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [L-1 ~> m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. @@ -84,15 +84,15 @@ module MOM_grid areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward - !! and the true northward directions. + !! and the true northward directions [nondim]. cos_rot !< The cosine of the angular rotation between the local model grid's northward - !! and the true northward directions. + !! and the true northward directions [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. OBCmaskCu, & !< 0 for boundary or OBC points and 1 for ocean points on the u grid [nondim]. - geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. - geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. + geoLatCu, & !< The geographic latitude at u points [degrees_N] or [km] or [m] + geoLonCu, & !< The geographic longitude at u points [degrees_E] or [km] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. @@ -104,8 +104,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. OBCmaskCv, & !< 0 for boundary or OBC points and 1 for ocean points on the v grid [nondim]. - geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. - geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. + geoLatCv, & !< The geographic latitude at v points [degrees_N] or [km] or [m] + geoLonCv, & !< The geographic longitude at v points [degrees_E] or [km] or [m]. dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. @@ -126,8 +126,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. - geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. - geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. + geoLatBu, & !< The geographic latitude at q points [degrees_N] or [km] or [m] + geoLonBu, & !< The geographic longitude at q points [degrees_E] or [km] or [m]. dxBu, & !< dxBu is delta x at q points [L ~> m]. IdxBu, & !< 1/dxBu [L-1 ~> m-1]. dyBu, & !< dyBu is delta y at q points [L ~> m]. @@ -181,8 +181,8 @@ module MOM_grid ! These parameters are run-time parameters that are used during some ! initialization routines (but not all) - real :: south_lat !< The latitude (or y-coordinate) of the first v-line - real :: west_lon !< The longitude (or x-coordinate) of the first u-line + real :: south_lat !< The latitude (or y-coordinate) of the first v-line [degrees_N] or [km] or [m] + real :: west_lon !< The longitude (or x-coordinate) of the first u-line [degrees_E] or [km] or [m] real :: len_lat !< The latitudinal (or y-coord) extent of physical domain real :: len_lon !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth !< The radius of the planet [m] @@ -221,9 +221,11 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v integer, allocatable, dimension(:) :: ibegin, iend, jbegin, jend character(len=40) :: mod_nm = "MOM_grid" ! This module's name. + mean_SeaLev_scale = 1.0 ; if (associated(G%US)) mean_SeaLev_scale = G%US%m_to_Z ! Read all relevant parameters and write them to the model log. - call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, default=0.0, do_not_log=.true.) + call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, & + units="m", default=0.0, scale=mean_SeaLev_scale, do_not_log=.true.) call log_version(param_file, mod_nm, version, & "Parameters providing information about the lateral grid.", & log_to_all=.true., layout=.true., all_default=(G%Z_ref==0.0)) @@ -236,7 +238,6 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v layoutParam=.true.) if (present(US)) then ; if (associated(US)) G%US => US ; endif - mean_SeaLev_scale = 1.0 ; if (associated(G%US)) mean_SeaLev_scale = G%US%m_to_Z call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, & "A reference value for geometric height fields, such as bathyT.", & units="m", default=0.0, scale=mean_SeaLev_scale) @@ -477,8 +478,8 @@ end subroutine set_derived_metrics !> Adcroft_reciprocal(x) = 1/x for |x|>0 or 0 for x=0. function Adcroft_reciprocal(val) result(I_val) - real, intent(in) :: val !< The value being inverted. - real :: I_val !< The Adcroft reciprocal of val. + real, intent(in) :: val !< The value being inverted [A]. + real :: I_val !< The Adcroft reciprocal of val [A-1]. I_val = 0.0 ; if (val /= 0.0) I_val = 1.0/val end function Adcroft_reciprocal @@ -488,12 +489,12 @@ logical function isPointInCell(G, i, j, x, y) type(ocean_grid_type), intent(in) :: G !< Grid type integer, intent(in) :: i !< i index of cell to test integer, intent(in) :: j !< j index of cell to test - real, intent(in) :: x !< x coordinate of point - real, intent(in) :: y !< y coordinate of point + real, intent(in) :: x !< x coordinate of point [degrees_E] + real, intent(in) :: y !< y coordinate of point [degrees_N] ! Local variables - real :: xNE, xNW, xSE, xSW ! Longitudes of cell corners [degLon] - real :: yNE, yNW, ySE, ySW ! Latitudes of cell corners [degLat] - real :: l0, l1, l2, l3 ! Crossed products of differences in position [degLon degLat] + real :: xNE, xNW, xSE, xSW ! Longitudes of cell corners [degrees_E] + real :: yNE, yNW, ySE, ySW ! Latitudes of cell corners [degrees_N] + real :: l0, l1, l2, l3 ! Crossed products of differences in position [degrees_E degrees_N] real :: p0, p1, p2, p3 ! Trinary unitary values reflecting the signs of the crossed products [nondim] isPointInCell = .false. xNE = G%geoLonBu(i ,j ) ; yNE = G%geoLatBu(i ,j ) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index fbfd4e3976..092b12a2d2 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3228,7 +3228,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) call get_param(param_file, mdl, 'DIAG_MISVAL', diag_cs%missing_value, & 'Set the default missing value to use for diagnostics.', & - default=1.e20) + units="various", default=1.e20) call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & 'Instead of writing diagnostics to the diag manager, write '//& 'a text file containing the checksum (bitcount) of the array.', & diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index e605f3e581..2ed64359cb 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -80,7 +80,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity (Pa s), !! in [R L2 T-1 ~> kg m-1 s-1]. real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity, - !! often in [kg-1/3 m-1/3 s-1]. + !! often in [Pa-3 s-1] if n_Glen is 3. real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries !! [L yr-1 ~> m yr-1] @@ -149,9 +149,9 @@ module MOM_ice_shelf_dynamics real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that - !! determines when to stop the conjugate gradient iterations. + !! determines when to stop the conjugate gradient iterations [nondim]. real :: nonlinear_tolerance !< The fractional nonlinear tolerance, relative to the initial error, - !! that sets when to stop the iterative velocity solver + !! that sets when to stop the iterative velocity solver [nondim] integer :: cg_max_iterations !< The maximum number of iterations that can be used in the CG solver integer :: nonlin_solve_err_mode !< 1: exit vel solve based on nonlin residual !! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol) where | | is infty-norm @@ -265,7 +265,7 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0*US%degC_to_C ) ! [C ~> degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3 s-1] - allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) ! [Pa] + allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) ! [R L2 T-2 ~> Pa] allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) @@ -389,7 +389,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). "//& - "This is only used with an ice-only model.", default=0.25) + "This is only used with an ice-only model.", units="nondim", default=0.25) endif call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & "avg ocean density used in floatation cond", & @@ -414,9 +414,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & - "tolerance in CG solver, relative to initial residual", default=1.e-6) + "tolerance in CG solver, relative to initial residual", units="nondim", default=1.e-6) call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", CS%nonlinear_tolerance, & - "nonlin tolerance in iterative velocity solve",default=1.e-6) + "nonlin tolerance in iterative velocity solve", units="nondim", default=1.e-6) call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & "max iteratiions in CG solver", default=2000) call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & @@ -1298,7 +1298,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! R,u,v,Z valid region moves in by 1 - ! beta_k = (Z \dot R) / (Zold \dot Rold} + ! beta_k = (Z \dot R) / (Zold \dot Rold) sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 do j=jscq,jecq ; do i=iscq,iecq @@ -2639,17 +2639,17 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) enddo ; enddo - if (trim(CS%ice_viscosity_compute)=="CONSTANT") then - CS%ice_visc(i,j) =1e15 * US%kg_m3_to_R*US%m_to_L*US%m_s_to_L_T * (G%areaT(i,j) * ISS%h_shelf(i,j)) - ! constant viscocity for debugging - elseif (trim(CS%ice_viscosity_compute)=="MODEL") then - CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & + if (trim(CS%ice_viscosity_compute)=="CONSTANT") then + CS%ice_visc(i,j) = 1e15 * US%kg_m3_to_R*US%m_to_L*US%m_s_to_L_T * (G%areaT(i,j) * ISS%h_shelf(i,j)) + ! constant viscocity for debugging + elseif (trim(CS%ice_viscosity_compute)=="MODEL") then + CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - elseif(trim(CS%ice_viscosity_compute)=="OBS") then - if (CS%AGlen_visc(i,j) >0) CS%ice_visc(i,j) =CS%AGlen_visc(i,j)*(G%areaT(i,j) * ISS%h_shelf(i,j)) - ! Here CS%Aglen_visc(i,j) is the ice viscocity [Pa s-1] computed from obs and read from a file - endif - endif + elseif (trim(CS%ice_viscosity_compute)=="OBS") then + if (CS%AGlen_visc(i,j) >0) CS%ice_visc(i,j) = CS%AGlen_visc(i,j)*(G%areaT(i,j) * ISS%h_shelf(i,j)) + ! Here CS%Aglen_visc(i,j) is the ice viscocity [Pa s-1] computed from obs and read from a file + endif + endif enddo ; enddo deallocate(Phi) end subroutine calc_shelf_visc diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index c48324962b..2a1a96168a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -219,7 +219,7 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) if (CS%do_bias_adjustment) then call get_param(PF, mdl, "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & "A multiplicative scaling factor for the climatological tracer tendency adjustment ", & - default=1.0) + units="nondim", default=1.0) endif call get_param(PF, mdl, "USE_BASIN_MASK", CS%use_basin_mask, & "If true, add a basin mask to delineate weakly connected "//& From 0111d4549ec8a66a74c6070f6e223fb9dd2dab2b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 30 Nov 2022 05:24:50 -0500 Subject: [PATCH 049/213] +Add x_ax_unit_short to ocean_grid_type Added the new elements x_ax_unit_short and y_ax_unit_short to the ocean_grid_type and the dyn_horgrid_type to facilitate the documentation of the units of variables when they depend on the units of the axes. This includes modifying some units that were being reported as the meaningless "[k]" into the meaningful "[km]", and some units that were being reported as just "[degrees]" are now being reported with the more specific "[degrees_E]" or "[degrees_N]". These new elements are also being used in the baroclinic_zone_initialization and circle_OBCs modules, and comments describing the units of a number of the internal variables in the former module were added or modified. The description of the AXIS_UNITS parameter was expanded to provide some of the other working options. All answers are bitwise identical, but there are minor changes in a number of the MOM_parameter_doc files. --- src/core/MOM_grid.F90 | 6 +- src/core/MOM_transcribe_grid.F90 | 2 + src/framework/MOM_dyn_horgrid.F90 | 9 ++- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 39 ++++++------ src/initialization/MOM_grid_initialize.F90 | 39 +++++++----- src/user/baroclinic_zone_initialization.F90 | 59 +++++++++++-------- src/user/circle_obcs_initialization.F90 | 4 +- 7 files changed, 95 insertions(+), 63 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index d2a0c86da8..2e413e505b 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -146,8 +146,12 @@ module MOM_grid gridLonB => NULL() !< The longitude of B points for the purpose of labeling the output axes. !! On many grids this is the same as geoLonBu. character(len=40) :: & + ! Except on a Cartesian grid, these are usually some variant of "degrees". x_axis_units, & !< The units that are used in labeling the x coordinate axes. - y_axis_units !< The units that are used in labeling the y coordinate axes. + y_axis_units, & !< The units that are used in labeling the y coordinate axes. + ! These are internally generated names, including "m", "km", "deg_E" and "deg_N". + x_ax_unit_short, & !< A short description of the x-axis units for documenting parameter units + y_ax_unit_short !< A short description of the y-axis units for documenting parameter units real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 8f8da21ef3..b8e213fa62 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -133,6 +133,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) ! Copy various scalar variables and strings. oG%x_axis_units = dG%x_axis_units ; oG%y_axis_units = dG%y_axis_units + oG%x_ax_unit_short = dG%x_ax_unit_short ; oG%y_ax_unit_short = dG%y_ax_unit_short oG%areaT_global = dG%areaT_global ; oG%IareaT_global = dG%IareaT_global oG%south_lat = dG%south_lat ; oG%west_lon = dG%west_lon oG%len_lat = dG%len_lat ; oG%len_lon = dG%len_lon @@ -291,6 +292,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) ! Copy various scalar variables and strings. dG%x_axis_units = oG%x_axis_units ; dG%y_axis_units = oG%y_axis_units + dG%x_ax_unit_short = oG%x_ax_unit_short ; dG%y_ax_unit_short = oG%y_ax_unit_short dG%areaT_global = oG%areaT_global ; dG%IareaT_global = oG%IareaT_global dG%south_lat = oG%south_lat ; dG%west_lon = oG%west_lon dG%len_lat = oG%len_lat ; dG%len_lon = oG%len_lon diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 60c30d8e94..8c163f710f 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -145,9 +145,12 @@ module MOM_dyn_horgrid !< The longitude of B points for the purpose of labeling the output axes. !! On many grids this is the same as geoLonBu. character(len=40) :: & + ! Except on a Cartesian grid, these are usually some variant of "degrees". x_axis_units, & !< The units that are used in labeling the x coordinate axes. - y_axis_units !< The units that are used in labeling the y coordinate axes. - ! Except on a Cartesian grid, these are usually some variant of "degrees". + y_axis_units, & !< The units that are used in labeling the y coordinate axes. + ! These are internally generated names, including "m", "km", "deg_E" and "deg_N". + x_ax_unit_short, & !< A short description of the x-axis units for documenting parameter units + y_ax_unit_short !< A short description of the y-axis units for documenting parameter units real, allocatable, dimension(:,:) :: & bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. @@ -382,6 +385,8 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns) G%x_axis_units = G_in%y_axis_units G%y_axis_units = G_in%x_axis_units + G%x_ax_unit_short = G_in%y_ax_unit_short + G%y_ax_unit_short = G_in%x_ax_unit_short G%south_lat = G_in%south_lat G%west_lon = G_in%west_lon G%len_lat = G_in%len_lat diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 479b1dfd1e..dabb075cf3 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -42,8 +42,9 @@ module MOM_IS_diag_mediator integer :: fms_diag_id !< underlying FMS diag id character(len=24) :: name !< The diagnostic name real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. - real, pointer, dimension(:,:) :: mask2d => null() !< A 2-d mask on the data domain for this diagnostic - real, pointer, dimension(:,:) :: mask2d_comp => null() !< A 2-d mask on the computational domain for this diagnostic + real, pointer, dimension(:,:) :: mask2d => null() !< A 2-d mask on the data domain for this diagnostic [nondim] + real, pointer, dimension(:,:) :: mask2d_comp => null() !< A 2-d mask on the computational domain + !! for this diagnostic [nondim] end type diag_type !> The SIS_diag_ctrl data type contains times to regulate diagnostics along with masks and @@ -64,7 +65,7 @@ module MOM_IS_diag_mediator integer :: ied !< The end i-index of cell centers within the data domain integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain - real :: time_int !< The time interval in s for any fields that are offered for averaging. + real :: time_int !< The time interval for any fields that are offered for averaging [s]. type(time_type) :: time_end !< The end time of the valid interval for any offered field. logical :: ave_enabled = .false. !< .true. if averaging is enabled. @@ -89,7 +90,7 @@ module MOM_IS_diag_mediator #define DIAG_ALLOC_CHUNK_SIZE 15 type(diag_type), dimension(:), allocatable :: diags !< The array of diagnostics integer :: next_free_diag_id !< The next unused diagnostic ID - !> default missing value to be sent to ALL diagnostics registerations + !> default missing value to be sent to ALL diagnostics registerations [various] real :: missing_value = -1.0e34 type(unit_scale_type), pointer :: US => null() !< A dimensional unit scaling type @@ -101,8 +102,8 @@ module MOM_IS_diag_mediator !> Set up the grid and axis information for use by the ice shelf model. subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output character(len=*), optional, intent(in) :: axes_set_name !< A name to use for this set of axes. !! The default is "ice". ! This subroutine sets up the grid and axis information for use by the ice shelf model. @@ -111,8 +112,8 @@ subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) integer :: id_xq, id_yq, id_xh, id_yh logical :: Cartesian_grid character(len=80) :: grid_config, units_temp, set_name -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_IS_diag_mediator" ! This module's name. set_name = "ice_shelf" ; if (present(axes_set_name)) set_name = trim(axes_set_name) @@ -128,8 +129,9 @@ subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) "\t spherical - a spherical grid \n"//& "\t mercator - a Mercator grid", fail_if_missing=.true.) - G%x_axis_units = "degrees_E" - G%y_axis_units = "degrees_N" + G%x_axis_units = "degrees_E" ; G%y_axis_units = "degrees_N" + G%x_ax_unit_short = "degrees_E" ; G%y_ax_unit_short = "degrees_N" + if (index(lowercase(trim(grid_config)),"cartesian") > 0) then ! This is a cartesian grid, and may have different axis units. Cartesian_grid = .true. @@ -141,8 +143,10 @@ subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) "implemented.", default='degrees') if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" + G%x_ax_unit_short = "km" ; G%y_ax_unit_short = "km" elseif (units_temp(1:1) == 'm') then G%x_axis_units = "meters" ; G%y_axis_units = "meters" + G%x_ax_unit_short = "m" ; G%y_ax_unit_short = "m" endif call log_param(param_file, mdl, "explicit AXIS_UNITS", G%x_axis_units) else @@ -343,12 +347,11 @@ end subroutine post_IS_data !> Enable the accumulation of time averages over the specified time interval. subroutine enable_averaging(time_int_in, time_end_in, diag_cs) - real, intent(in) :: time_int_in !< The time interval over which any values -! !! that are offered are valid [s]. - type(time_type), intent(in) :: time_end_in !< The end time of the valid interval. - type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output -! This subroutine enables the accumulation of time averages over the -! specified time interval. + real, intent(in) :: time_int_in !< The time interval over which any values + !! that are offered are valid [s]. + type(time_type), intent(in) :: time_end_in !< The end time of the valid interval. + type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output + ! This subroutine enables the accumulation of time averages over the specified time interval. ! if (num_file==0) return diag_cs%time_int = time_int_in @@ -371,8 +374,8 @@ subroutine enable_averages(time_int, time_end, diag_CS, T_to_s) !! that are offered are valid [T ~> s]. type(time_type), intent(in) :: time_end !< The end time of the valid interval. type(diag_ctrl), intent(inout) :: diag_CS !< A structure that is used to regulate diagnostic output - real, optional, intent(in) :: T_to_s !< A conversion factor for time_int to [s]. -! This subroutine enables the accumulation of time averages over the specified time interval. + real, optional, intent(in) :: T_to_s !< A conversion factor for time_int to seconds [s T-1 ~> 1]. + ! This subroutine enables the accumulation of time averages over the specified time interval. if (present(T_to_s)) then diag_cs%time_int = time_int*T_to_s diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index d84d2275e4..964007c663 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -27,17 +27,17 @@ module MOM_grid_initialize !> Global positioning system (aka container for information to describe the grid) type, private :: GPS ; private - real :: len_lon !< The longitudinal or x-direction length of the domain. - real :: len_lat !< The latitudinal or y-direction length of the domain. + real :: len_lon !< The longitudinal or x-direction length of the domain [degrees_E] or [km] or [m]. + real :: len_lat !< The latitudinal or y-direction length of the domain [degrees_N] or [km] or [m]. real :: west_lon !< The western longitude of the domain or the equivalent - !! starting value for the x-axis. + !! starting value for the x-axis [degrees_E] or [km] or [m]. real :: south_lat !< The southern latitude of the domain or the equivalent - !! starting value for the y-axis. + !! starting value for the y-axis [degrees_N] or [km] or [m]. real :: Rad_Earth_L !< The radius of the Earth in rescaled units [L ~> m] real :: Lat_enhance_factor !< The amount by which the meridional resolution - !! is enhanced within LAT_EQ_ENHANCE of the equator. + !! is enhanced within LAT_EQ_ENHANCE of the equator [nondim] real :: Lat_eq_enhance !< The latitude range to the north and south of the equator - !! over which the resolution is enhanced, in degrees. + !! over which the resolution is enhanced [degrees_N] logical :: isotropic !< If true, an isotropic grid on a sphere (also known as a Mercator grid) !! is used. With an isotropic grid, the meridional extent of the domain !! (LENLAT), the zonal extent (LENLON), and the number of grid points in each @@ -83,6 +83,8 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" + G%x_ax_unit_short = "degrees_E" ; G%y_ax_unit_short = "degrees_N" + G%Rad_Earth_L = -1.0*US%m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 select case (trim(config)) case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) @@ -379,7 +381,10 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & "The units for the Cartesian axes. Valid entries are: \n"//& " \t degrees - degrees of latitude and longitude \n"//& - " \t m - meters \n \t k - kilometers", default="degrees") + " \t m or meter(s) - meters \n"//& + " \t k or km or kilometer(s) - kilometers", default="degrees") + if (trim(units_temp) == "k") units_temp = "km" + call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & "The southern latitude of the domain or the equivalent "//& "starting value for the y-axis.", units=units_temp, & @@ -399,8 +404,10 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" + G%x_ax_unit_short = "km" ; G%y_ax_unit_short = "km" elseif (units_temp(1:1) == 'm') then G%x_axis_units = "meters" ; G%y_axis_units = "meters" + G%x_ax_unit_short = "m" ; G%y_ax_unit_short = "m" endif call log_param(param_file, mdl, "explicit AXIS_UNITS", G%x_axis_units) @@ -513,16 +520,16 @@ subroutine set_grid_metrics_spherical(G, param_file, US) PI = 4.0*atan(1.0); PI_180 = atan(1.0)/45. call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & - "The southern latitude of the domain.", units="degrees", & + "The southern latitude of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "LENLAT", G%len_lat, & - "The latitudinal length of the domain.", units="degrees", & + "The latitudinal length of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "WESTLON", G%west_lon, & - "The western longitude of the domain.", units="degrees", & + "The western longitude of the domain.", units="degrees_E", & default=0.0) call get_param(param_file, mdl, "LENLON", G%len_lon, & - "The longitudinal length of the domain.", units="degrees", & + "The longitudinal length of the domain.", units="degrees_E", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) @@ -668,16 +675,16 @@ subroutine set_grid_metrics_mercator(G, param_file, US) PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI call get_param(param_file, mdl, "SOUTHLAT", GP%south_lat, & - "The southern latitude of the domain.", units="degrees", & + "The southern latitude of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "LENLAT", GP%len_lat, & - "The latitudinal length of the domain.", units="degrees", & + "The latitudinal length of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "WESTLON", GP%west_lon, & - "The western longitude of the domain.", units="degrees", & + "The western longitude of the domain.", units="degrees_E", & default=0.0) call get_param(param_file, mdl, "LENLON", GP%len_lon, & - "The longitudinal length of the domain.", units="degrees", & + "The longitudinal length of the domain.", units="degrees_E", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth_L, & "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) @@ -704,7 +711,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) units="nondim", default=1.0) call get_param(param_file, mdl, "LAT_EQ_ENHANCE", GP%Lat_eq_enhance, & "The latitude range to the north and south of the equator "//& - "over which the resolution is enhanced.", units="degrees", & + "over which the resolution is enhanced.", units="degrees_N", & default=0.0) ! With an isotropic grid, the north-south extent of the domain, diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index eb1f943b87..2ff4e1ec80 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -36,14 +36,17 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, real, intent(out) :: S_ref !< Reference salinity [S ~> ppt] real, intent(out) :: dSdz !< Salinity stratification [S Z-1 ~> ppt m-1] real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [S ~> ppt] - real, intent(out) :: dSdx !< Linear salinity gradient - !! in [S G%xaxis_units-1 ~> ppt G%xaxis_units-1] + real, intent(out) :: dSdx !< Linear salinity gradient, often in [S km-1 ~> ppt km-1] + !! or [S degrees_E-1 ~> ppt degrees_E-1], depending on + !! the value of G%x_axis_units real, intent(out) :: T_ref !< Reference temperature [C ~> degC] real, intent(out) :: dTdz !< Temperature stratification [C Z-1 ~> degC m-1] real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [C ~> degC] - real, intent(out) :: dTdx !< Linear temperature gradient - !! in [C G%x_axis_units-1 ~> degC G%x_axis_units-1] - real, intent(out) :: L_zone !< Width of baroclinic zone in [G%x_axis_units] + real, intent(out) :: dTdx !< Linear temperature gradient, often in [C km-1 ~> degC km-1] + !! or [C degrees_E-1 ~> degC degrees_E-1], depending on + !! the value of G%x_axis_units + real, intent(out) :: L_zone !< Width of baroclinic zone, often in [km] or [degrees_N], + !! depending on the value of G%y_axis_units logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. @@ -53,21 +56,21 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & units='ppt', default=35., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & - units='ppt/m', default=0.0, scale=US%ppt_to_S*US%Z_to_m, do_not_log=just_read) - call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & + units='ppt m-1', default=0.0, scale=US%ppt_to_S*US%Z_to_m, do_not_log=just_read) + call get_param(param_file, mdl, "DELTA_S",delta_S, 'Salinity difference across baroclinic zone', & units='ppt', default=0.0, scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & - units='ppt/'//trim(G%x_axis_units), default=0.0, scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & - units='C', default=10., scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DSDX", dSdx,'Meridional salinity difference', & + units='ppt '//trim(G%x_ax_unit_short)//'-1', default=0.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & + units='degC', default=10., scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & - units='C/m', default=0.0, scale=US%degC_to_C*US%Z_to_m, do_not_log=just_read) - call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & - units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) - call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & - units='C/'//trim(G%x_axis_units), default=0.0, scale=US%degC_to_C, do_not_log=just_read) - call get_param(param_file, mdl,"L_ZONE",L_zone,'Width of baroclinic zone', & - units=G%x_axis_units, default=0.5*G%len_lat, do_not_log=just_read) + units='degC m-1', default=0.0, scale=US%degC_to_C*US%Z_to_m, do_not_log=just_read) + call get_param(param_file, mdl, "DELTA_T", delta_T,'Temperature difference across baroclinic zone', & + units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DTDX", dTdx,'Meridional temperature difference', & + units='degC '//trim(G%x_ax_unit_short)//'-1', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "L_ZONE", L_zone, 'Width of baroclinic zone', & + units=G%y_ax_unit_short, default=0.5*G%len_lat, do_not_log=just_read) call closeParameterBlock(param_file) end subroutine bcz_params @@ -92,12 +95,20 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz - real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution [C ~> degC] - real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution [S ~> ppt] - real :: L_zone ! Width of baroclinic zone in [G%axis_units] - real :: zc, zi ! Depths in depth units [Z ~> m] - real :: x, xd, xs, y, yd, fn - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: T_ref, delta_T ! Parameters describing temperature distribution [C ~> degC] + real :: dTdz ! Vertical temperature gradients [C Z-1 ~> degC m-1] + real :: dTdx ! Zonal temperature gradients [C axis_units-1 ~> degC axis_units-1] + real :: S_ref, delta_S ! Parameters describing salinity distribution [S ~> ppt] + real :: dSdz ! Vertical salinity gradients [S Z-1 ~> ppt m-1] + real :: dSdx ! Zonal salinity gradients [S axis_units-1 ~> ppt axis_units-1] + real :: L_zone ! Width of baroclinic zone, often in [km] or [degrees_N], depending + ! on the value of G%y_axis_units + real :: zc, zi ! Depths in depth units [Z ~> m] + real :: x ! X-position relative to the domain center [degrees_E] or [km] or [m] + real :: y ! Y-position relative to the domain center [degrees_N] or [km] or [m] + real :: fn ! A smooth function based on the position in the baroclinic zone [nondim] + real :: xs, xd, yd ! Fractional x- and y-positions relative to the domain extent [nondim] + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 9553aafafb..f8e9b342ac 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -59,11 +59,11 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus ! Parameters read by cartesian grid initialization call get_param(param_file, mdl, "DISK_RADIUS", diskrad, & "The radius of the initially elevated disk in the "//& - "circle_obcs test case.", units=G%x_axis_units, & + "circle_obcs test case.", units=G%x_ax_unit_short, & fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "DISK_X_OFFSET", xOffset, & "The x-offset of the initially elevated disk in the "//& - "circle_obcs test case.", units=G%x_axis_units, & + "circle_obcs test case.", units=G%x_ax_unit_short, & default = 0.0, do_not_log=just_read) call get_param(param_file, mdl, "DISK_IC_AMPLITUDE", IC_amp, & "Initial amplitude of interface height displacements "//& From 490bfcae44a38df05e84c732ad117cdab705f78b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Dec 2022 07:37:34 -0500 Subject: [PATCH 050/213] Scale default parameters Apply dimensional rescaling of parameters that are only used as defaults for other parameters, with the rescaling explicitly undone as a part of the default argument specification. This includes de-emphasizing the use of GV%Angstrom_m, instead using GV%Angstrom_Z. As a result, fewer get_param calls read in dimensional variables without specifying a scaling factor that can be compared with their declared units. All answers and output are bitwise identical. --- src/core/MOM_open_boundary.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 10 +-- .../MOM_coord_initialization.F90 | 24 ++++--- .../MOM_state_initialization.F90 | 12 ++-- src/parameterizations/lateral/MOM_MEKE.F90 | 22 +++---- .../lateral/MOM_tidal_forcing.F90 | 22 ++++--- .../vertical/MOM_bkgnd_mixing.F90 | 30 ++++----- .../vertical/MOM_bulk_mixed_layer.F90 | 24 +++---- .../vertical/MOM_energetic_PBL.F90 | 8 +-- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 63 +++++++++---------- 11 files changed, 111 insertions(+), 108 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index abe63a950a..47d6953ce1 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -5590,7 +5590,7 @@ end subroutine remap_OBC_fields !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_m. +!! layers are contracted to GV%Angstrom_Z. !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 2df65f09aa..e40ab20d5c 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -114,9 +114,9 @@ subroutine verticalGridInit( param_file, GV, US ) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) - call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & + call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_Z, & "The minimum layer thickness, usually one-Angstrom.", & - units="m", default=1.0e-10) + units="m", default=1.0e-10, scale=US%m_to_Z) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & "An integer power of 2 that is used to rescale the model's "//& "intenal units of thickness. Valid values range from -300 to 300.", & @@ -156,13 +156,13 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_kg_m2 = US%R_to_kg_m3*GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m - GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m + GV%Angstrom_H = GV%m_to_H * US%Z_to_m*GV%Angstrom_Z GV%H_to_MKS = GV%H_to_m else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H GV%H_to_m = GV%H_to_kg_m2 / (US%R_to_kg_m3*GV%Rho0) - GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H + GV%Angstrom_H = US%Z_to_m*GV%Angstrom_Z * 1000.0*GV%kg_m2_to_H GV%H_to_MKS = GV%H_to_kg_m2 endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) @@ -170,7 +170,7 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H - GV%Angstrom_Z = US%m_to_Z * GV%Angstrom_m + GV%Angstrom_m = US%Z_to_m * GV%Angstrom_Z GV%H_to_RZ = GV%H_to_kg_m2 * US%kg_m3_to_R * US%m_to_Z GV%RZ_to_H = GV%kg_m2_to_H * US%R_to_kg_m3 * US%Z_to_m diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 66c09cb6a3..c956c6b4be 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -314,8 +314,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta real, dimension(GV%ke) :: T0 ! A profile of temperatures [C ~> degC] real, dimension(GV%ke) :: S0 ! A profile of salinities [S ~> ppt] real, dimension(GV%ke) :: Pref ! A array of reference pressures [R L2 T-2 ~> Pa] - real :: S_Ref ! Default salinity range parameters [ppt]. - real :: T_Ref ! Default temperature range parameters [degC]. + real :: S_Ref ! Default salinity range parameters [S ~> ppt]. + real :: T_Ref ! Default temperature range parameters [C ~> degC]. real :: S_Light, S_Dense ! Salinity range parameters [S ~> ppt]. real :: T_Light, T_Dense ! Temperature range parameters [C ~> degC]. real :: res_rat ! The ratio of density space resolution in the denser part @@ -332,22 +332,26 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") call get_param(param_file, mdl, "T_REF", T_Ref, & - "The default initial temperatures.", units="degC", default=10.0) + "The default initial temperatures.", & + units="degC", default=10.0, scale=US%degC_to_C) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_Light, & "The initial temperature of the lightest layer when "//& - "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref, scale=US%degC_to_C) + "COORD_CONFIG is set to ts_range.", & + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_Dense, & "The initial temperature of the densest layer when "//& - "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref, scale=US%degC_to_C) + "COORD_CONFIG is set to ts_range.", & + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C) call get_param(param_file, mdl, "S_REF", S_Ref, & - "The default initial salinities.", units="PSU", default=35.0) + "The default initial salinities.", & + units="PSU", default=35.0, scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_Light, & - "The initial lightest salinities when COORD_CONFIG "//& - "is set to ts_range.", default = S_Ref, units="PSU", scale=US%ppt_to_S) + "The initial lightest salinities when COORD_CONFIG is set to ts_range.", & + units="PSU", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_Dense, & - "The initial densest salinities when COORD_CONFIG "//& - "is set to ts_range.", default = S_Ref, units="PSU", scale=US%ppt_to_S) + "The initial densest salinities when COORD_CONFIG is set to ts_range.", & + units="PSU", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & "The ratio of density space resolution in the densest "//& diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index d3e8a2b18a..62438cbc7f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1782,8 +1782,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P "A reference temperature used in initialization.", & units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, scale=US%ppt_to_S, do_not_log=just_read) + "A reference salinity used in initialization.", & + units="PSU", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & "If true, accept the prescribed temperature and fit the "//& "salinity; otherwise take salinity and fit temperature.", & @@ -2480,8 +2480,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just integer :: nkd ! number of levels to use for regridding input arrays real :: eps_Z ! A negligibly thin layer thickness [Z ~> m]. real :: eps_rho ! A negligibly small density difference [R ~> kg m-3]. - real :: PI_180 ! for conversion from degrees to radians - real :: Hmix_default ! The default initial mixed layer depth [m]. + real :: PI_180 ! for conversion from degrees to radians [radian degree-1] + real :: Hmix_default ! The default initial mixed layer depth [Z ~> m]. real :: Hmix_depth ! The mixed layer depth in the initial condition [Z ~> m]. real :: missing_value_temp ! The missing value in the input temperature field real :: missing_value_salt ! The missing value in the input salinity field @@ -2680,10 +2680,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just default=.false., do_not_log=just_read.or.(GV%nkml==0)) if (GV%nkml == 0) separate_mixed_layer = .false. call get_param(PF, mdl, "MINIMUM_DEPTH", Hmix_default, & - units="m", default=0.0, scale=1.0) + units="m", default=0.0, scale=US%m_to_Z) call get_param(PF, mdl, "Z_INIT_HMIX_DEPTH", Hmix_depth, & "The mixed layer depth in the initial conditions when Z_INIT_SEPARATE_MIXED_LAYER "//& - "is set to true.", default=Hmix_default, units="m", scale=US%m_to_Z, & + "is set to true.", units="m", default=US%Z_to_m*Hmix_default, scale=US%m_to_Z, & do_not_log=(just_read .or. .not.separate_mixed_layer)) call get_param(PF, mdl, "LAYER_Z_INIT_IC_EXTRAP_BUG", density_extrap_bug, & "If true use an expression with a vertical indexing bug for extrapolating the "//& diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 18c156e1f1..10d4270202 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1196,8 +1196,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "each time step.", default=.false.) if (CS%MEKE_equilibrium_restoring) then call get_param(param_file, mdl, "MEKE_RESTORING_TIMESCALE", MEKE_restoring_timescale, & - "The timescale used to nudge MEKE toward its equilibrium value.", units="s", & - default=1e6, scale=US%s_to_T) + "The timescale used to nudge MEKE toward its equilibrium value.", & + units="s", default=1e6, scale=US%s_to_T) CS%MEKE_restoring_rate = 1.0 / MEKE_restoring_timescale endif @@ -1210,8 +1210,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "by GME. If MEKE_GMECOEFF is negative, this conversion "//& "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & - "A background energy source for MEKE.", units="W kg-1", & - default=0.0, scale=US%m_to_L**2*US%T_to_s**3) + "A background energy source for MEKE.", & + units="W kg-1", default=0.0, scale=US%m_to_L**2*US%T_to_s**3) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & @@ -1248,11 +1248,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "If true, use the vertvisc_type to calculate the bottom "//& "drag acting on MEKE.", default=.true.) call get_param(param_file, mdl, "MEKE_KHTH_FAC", MEKE%KhTh_fac, & - "A factor that maps MEKE%Kh to KhTh.", units="nondim", & - default=0.0) + "A factor that maps MEKE%Kh to KhTh.", units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_KHTR_FAC", MEKE%KhTr_fac, & - "A factor that maps MEKE%Kh to KhTr.", units="nondim", & - default=0.0) + "A factor that maps MEKE%Kh to KhTr.", units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_KHMEKE_FAC", CS%KhMEKE_Fac, & "A factor that maps MEKE%Kh to Kh for MEKE itself.", & units="nondim", default=0.0) @@ -1336,13 +1334,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, ! Nonlocal module parameters call get_param(param_file, mdl, "CDRAG", cdrag, & - "CDRAG is the drag coefficient relating the magnitude of "//& - "the velocity field to the bottom stress.", units="nondim", & - default=0.003) + "CDRAG is the drag coefficient relating the magnitude of the velocity "//& + "field to the bottom stress.", units="nondim", default=0.003) call get_param(param_file, mdl, "MEKE_CDRAG", CS%cdrag, & "Drag coefficient relating the magnitude of the velocity "//& - "field to the bottom stress in MEKE.", units="nondim", & - default=cdrag) + "field to the bottom stress in MEKE.", units="nondim", default=cdrag) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index dcf12f915f..520c70172f 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -70,16 +70,16 @@ module MOM_tidal_forcing sin_struct(:,:,:), & !< The sine and cosine based structures that can cos_struct(:,:,:), & !< be associated with the astronomical forcing [nondim]. cosphasesal(:,:,:), & !< The cosine and sine of the phase of the - sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. + sinphasesal(:,:,:), & !< self-attraction and loading amphidromes [nondim]. ampsal(:,:,:), & !< The amplitude of the SAL [Z ~> m]. cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the - sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. + sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions [nondim]. amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. type(sht_CS) :: sht !< Spherical harmonic transforms (SHT) for SAL - integer :: sal_sht_Nd !< Maximum degree for SHT [nodim] - real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nodim] - real, allocatable :: Snm_Re(:), & !< Real and imaginary SHT coefficient for SHT SAL - Snm_Im(:) !< [Z ~> m] + integer :: sal_sht_Nd !< Maximum degree for SHT [nondim] + real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nondim] + real, allocatable :: Snm_Re(:), & !< Real SHT coefficient for SHT SAL [Z ~> m] + Snm_Im(:) !< Imaginary SHT coefficient for SHT SAL [Z ~> m] end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -99,9 +99,12 @@ module MOM_tidal_forcing subroutine astro_longitudes_init(time_ref, longitudes) type(time_type), intent(in) :: time_ref !> Time to calculate longitudes for. type(astro_longitudes), intent(out) :: longitudes !> Lunar and solar longitudes at time_ref. + + ! Local variables real :: D !> Time since the reference date [days] real :: T !> Time in Julian centuries [centuries] real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] + ! Find date at time_ref in days since 1900-01-01 D = time_type_to_real(time_ref - set_date(1900, 1, 1)) / (24.0 * 3600.0) ! Time since 1900-01-01 in Julian centuries @@ -542,7 +545,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) call get_param(param_file, mdl, "TIDAL_SAL_SHT_DEGREE", CS%sal_sht_Nd, & "The maximum degree of the spherical harmonics transformation used for "// & "calculating the self-attraction and loading term for tides.", & - default=0, do_not_log=.not. CS%tidal_sal_sht) + default=0, do_not_log=.not.CS%tidal_sal_sht) call get_param(param_file, mdl, "RHO_0", rhoW, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -551,8 +554,9 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.True.) call get_param(param_file, mdl, "RHO_E", rhoE, & "The mean solid earth density. This is used for calculating the "// & - "self-attraction and loading term.", units="kg m-3", & - default=5517.0, scale=US%kg_m3_to_R, do_not_log=.not. CS%tidal_sal_sht) + "self-attraction and loading term.", & + units="kg m-3", default=5517.0, scale=US%kg_m3_to_R, & + do_not_log=.not.CS%tidal_sal_sht) lmax = calc_lmax(CS%sal_sht_Nd) allocate(CS%Snm_Re(lmax)); CS%Snm_Re(:) = 0.0 allocate(CS%Snm_Im(lmax)); CS%Snm_Im(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 5a39f83c5d..6d016aa18b 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -37,13 +37,13 @@ module MOM_bkgnd_mixing ! Parameters real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile - !! at |z|=D [m2 s-1] + !! at |z|=D [Z2 T-1 ~> m2 s-1] real :: Bryan_Lewis_c2 !< The amplitude of variation in diffusivity for the - !! Bryan-Lewis diffusivity profile [m2 s-1] + !! Bryan-Lewis diffusivity profile [Z2 T-1 ~> m2 s-1] real :: Bryan_Lewis_c3 !< The inverse length scale for transition region in the - !! Bryan-Lewis diffusivity profile [m-1] + !! Bryan-Lewis diffusivity profile [Z-1 ~> m-1] real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the - !! Bryan-Lewis profile [m] + !! Bryan-Lewis profile [Z ~> m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when @@ -156,7 +156,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KDML is a depricated parameter that should not be used.") call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & - units="m2 s-1", default=-1., scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KD_ML_TOT cannot be set when using a physically based ocean "//& "boundary layer mixing parameterization.") @@ -202,19 +202,19 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL call get_param(param_file, mdl, "BRYAN_LEWIS_C1", CS%Bryan_Lewis_c1, & "The vertical diffusivity values for Bryan-Lewis profile at |z|=D.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "BRYAN_LEWIS_C2", CS%Bryan_Lewis_c2, & "The amplitude of variation in diffusivity for the Bryan-Lewis profile", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "BRYAN_LEWIS_C3", CS%Bryan_Lewis_c3, & "The inverse length scale for transition region in the Bryan-Lewis profile", & - units="m-1", fail_if_missing=.true.) + units="m-1", scale=US%Z_to_m, fail_if_missing=.true.) call get_param(param_file, mdl, "BRYAN_LEWIS_C4", CS%Bryan_Lewis_c4, & "The depth where diffusivity is BRYAN_LEWIS_C1 in the Bryan-Lewis profile",& - units="m", fail_if_missing=.true.) + units="m", scale=US%m_to_Z, fail_if_missing=.true.) endif ! CS%Bryan_Lewis_diffusivity @@ -276,8 +276,8 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL "the Earth's rotation period, used with the Henyey "//& "scaling from the mixing.", units="nondim", default=20.0) call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) endif call get_param(param_file, mdl, "KD_TANH_LAT_FN", CS%Kd_tanh_lat_fn, & @@ -369,10 +369,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, call CVMix_init_bkgnd(max_nlev=nz, & zw = depth_int(:), & !< interface depths relative to the surface in m, must be positive. - bl1 = CS%Bryan_Lewis_c1, & - bl2 = CS%Bryan_Lewis_c2, & - bl3 = CS%Bryan_Lewis_c3, & - bl4 = CS%Bryan_Lewis_c4, & + bl1 = US%Z2_T_to_m2_s*CS%Bryan_Lewis_c1, & + bl2 = US%Z2_T_to_m2_s*CS%Bryan_Lewis_c2, & + bl3 = US%m_to_Z*CS%Bryan_Lewis_c3, & + bl4 = US%Z_to_m*CS%Bryan_Lewis_c4, & prandtl = CS%prandtl_bkgnd) Kd_col(:) = 0.0 ; Kv_col(:) = 0.0 ! Is this line necessary? diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 2f8e03480e..a00e97a497 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -49,7 +49,7 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE [nondim]. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE [nondim]. - real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to @@ -3357,12 +3357,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) !! output. type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] real :: omega_frac_dflt ! The default value for ML_OMEGA_FRAC [nondim] - real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [m s-1] + real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [Z T-1 ~> m s-1] real :: Hmix_min_m ! The unscaled value of HMIX_MIN [m] integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega @@ -3396,8 +3396,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "BULK_RI_ML", CS%bulk_Ri_ML, & "The efficiency with which mean kinetic energy released "//& "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy.", units="nondim",& - fail_if_missing=.true.) + "is converted to turbulent kinetic energy.", & + units="nondim", fail_if_missing=.true.) call get_param(param_file, mdl, "ABSORB_ALL_SW", CS%absorb_all_sw, & "If true, all shortwave radiation is absorbed by the "//& "ocean, instead of passing through to the bottom mud.", & @@ -3409,8 +3409,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "NSTAR2", CS%nstar2, & "The portion of any potential energy released by "//& "convective adjustment that is available to drive "//& - "entrainment at the base of mixed layer. By default "//& - "NSTAR2=NSTAR.", units="nondim", default=CS%nstar) + "entrainment at the base of mixed layer. By default NSTAR2=NSTAR.", & + units="nondim", default=CS%nstar) call get_param(param_file, mdl, "BULK_RI_CONVECTIVE", CS%bulk_Ri_convective, & "The efficiency with which convectively released mean "//& "kinetic energy is converted to turbulent kinetic "//& @@ -3446,7 +3446,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "relative to the density range within the mixed and "//& "buffer layers, when the detrainment is going into the "//& "lightest interior layer, nondimensional, or a negative "//& - "value not to apply this limit.", units="nondim", default = -1.0) + "value not to apply this limit.", units="nondim", default=-1.0) call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_THICK", CS%Hbuffer_min, & "The minimum buffer layer thickness when the mixed layer is very thick.", & units="m", default=5.0, scale=GV%m_to_H) @@ -3493,12 +3493,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*US%s_to_T*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the "//& "bulk mixed layer model in setting vertical TKE decay "//& - "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) + "scales. This must be greater than 0.", & + units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 852ff4cee1..bd0740ccbd 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1961,8 +1961,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/1. General ePBL settings call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_S) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_S) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -2014,8 +2014,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & "The efficiency with which mean kinetic energy released "//& "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy.", units="nondim", & - default=0.0) + "is converted to turbulent kinetic energy.", & + units="nondim", default=0.0) call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "TKE_DECAY relates the vertical rate of decay of the "//& "TKE available for mechanical entrainment to the natural "//& diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 792c30cc98..9e749874c3 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2114,7 +2114,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re units="s", scale=US%s_to_T, fail_if_missing=.true., do_not_log=just_read_params) call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)*US%Z_to_m), scale=GV%m_to_H, & + units="m", default=US%Z_to_m*MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H, & do_not_log=just_read_params) CS%Rho_sig_off = 1000.0*US%kg_m3_to_R diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 249cbb5777..91c85ced26 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1995,11 +1995,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS real :: TKE_decay_dflt ! The default value of a coefficient scaling the vertical decay ! rate of TKE [nondim] real :: bulk_Ri_ML_dflt ! The default bulk Richardson number for a bulk mixed layer [nondim] - real :: Kv_background ! The background kinematic viscosity in the interior [m2 s-1] + real :: Kv_background ! The background kinematic viscosity in the interior [Z2 T-1 ~> m2 s-1] real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate that ! is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] - real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [m] + real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [Z ~> m] + real :: Hbbl ! The static bottom boundary layer thickness [Z ~> m]. + real :: BBL_thick_min ! The minimum bottom boundary layer thickness [Z ~> m]. real :: Z_rescale ! A rescaling factor for heights from the representation in ! a restart file to the internal representation in this run [nondim]? @@ -2103,19 +2105,17 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%dynamic_viscous_ML) then call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, units="nondim", default=0.0) call get_param(param_file, mdl, "BULK_RI_ML_VISC", CS%bulk_Ri_ML, & - "The efficiency with which mean kinetic energy released "//& - "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy. By default, "//& - "BULK_RI_ML_VISC = BULK_RI_ML or 0.", units="nondim", & - default=bulk_Ri_ML_dflt) + "The efficiency with which mean kinetic energy released by mechanically "//& + "forced entrainment of the mixed layer is converted to turbulent "//& + "kinetic energy. By default, BULK_RI_ML_VISC = BULK_RI_ML or 0.", & + units="nondim", default=bulk_Ri_ML_dflt) call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, units="nondim", default=0.0) call get_param(param_file, mdl, "TKE_DECAY_VISC", CS%TKE_decay, & "TKE_DECAY_VISC relates the vertical rate of decay of "//& "the TKE available for mechanical entrainment to the "//& "natural Ekman depth for use in calculating the dynamic "//& - "mixed layer viscosity. By default, "//& - "TKE_DECAY_VISC = TKE_DECAY or 0.", units="nondim", & - default=TKE_decay_dflt) + "mixed layer viscosity. By default, TKE_DECAY_VISC = TKE_DECAY or 0.", & + units="nondim", default=TKE_decay_dflt) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -2131,28 +2131,27 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) endif - call get_param(param_file, mdl, "HBBL", CS%Hbbl, & + call get_param(param_file, mdl, "HBBL", Hbbl, & "The thickness of a bottom boundary layer with a viscosity increased by "//& "KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//& "near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//& "defined but LINEAR_DRAG is not.", & - units="m", fail_if_missing=.true.) ! Rescaled later + units="m", scale=US%m_to_Z, fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress. CDRAG is only "//& - "used if BOTTOMDRAGLAW is defined.", units="nondim", & - default=0.003) + "used if BOTTOMDRAGLAW is defined.", units="nondim", default=0.003) call get_param(param_file, mdl, "BBL_USE_TIDAL_BG", CS%BBL_use_tidal_bg, & "Flag to use the tidal RMS amplitude in place of constant "//& "background velocity for computing u* in the BBL. "//& @@ -2187,25 +2186,26 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (use_regridding .and. (.not. CS%BBL_use_EOS)) & call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to set BBL_USE_EOS to True.") endif - call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, & + call get_param(param_file, mdl, "BBL_THICK_MIN", BBL_thick_min, & "The minimum bottom boundary layer thickness that can be "//& "used with BOTTOMDRAGLAW. This might be "//& "Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//& - "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later + "near-bottom viscosity.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & "The minimum top boundary layer thickness that can be "//& "used with BOTTOMDRAGLAW. This might be "//& "Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//& - "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H) + "near-top viscosity.", units="m", default=US%Z_to_m*BBL_thick_min, scale=GV%m_to_H) call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & "The thickness over which near-surface velocities are "//& "averaged for the drag law under an ice shelf. By "//& - "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) + "default this is the same as HBBL", & + units="m", default=US%Z_to_m*Hbbl, scale=GV%m_to_H) call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "USE_KPP", use_KPP, & "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "//& @@ -2214,10 +2214,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "CORRECT_BBL_BOUNDS", CS%correct_BBL_bounds, & "If true, uses the correct bounds on the BBL thickness and "//& "viscosity so that the bottom layer feels the intended drag.", & @@ -2239,23 +2239,22 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%c_Smag < 0.0) CS%c_Smag = 0.15 endif - Chan_max_thick_dflt = -1.0 - if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*CS%Hbbl - if (CS%body_force_drag) Chan_max_thick_dflt = CS%Hbbl + Chan_max_thick_dflt = -1.0*US%m_to_Z + if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*Hbbl + if (CS%body_force_drag) Chan_max_thick_dflt = Hbbl call get_param(param_file, mdl, "CHANNEL_DRAG_MAX_BBL_THICK", CS%Chan_drag_max_vol, & "The maximum bottom boundary layer thickness over which the channel drag is "//& "exerted, or a negative value for no fixed limit, instead basing the BBL "//& "thickness on the bottom stress, rotation and stratification. The default is "//& "proportional to HBBL if USE_JACKSON_PARAM or DRAG_AS_BODY_FORCE is true.", & - units="m", default=Chan_max_thick_dflt, scale=GV%m_to_H, & + units="m", default=US%Z_to_m*Chan_max_thick_dflt, scale=GV%m_to_H, & do_not_log=.not.CS%Channel_drag) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & default=.false., do_not_log=.true.) - ! These unit conversions are out outside the get_param calls because they are also defaults. - CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale - CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale + CS%Hbbl = Hbbl * GV%Z_to_H ! Rescaled for later use + CS%BBL_thick_min = BBL_thick_min * GV%Z_to_H ! Rescaled for later use if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then ! This is necessary for reproducibility across restarts in non-symmetric mode. From c80db6786a8061ab744ddafa81c6ac7893fb213a Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Fri, 2 Dec 2022 16:49:19 -0700 Subject: [PATCH 051/213] Make sure EBT structure is computed when desired This addition makes sure that CS%ebt_struct is filled/computed if the user specifies KHTH_USE_EBT_STRUCT = True. Before this addition, an array for CS%ebt_struct got allocated and initialized to 0, if KHTH_USE_EBT_STRUCT = True. But this array never got filled (with values other than 0) unless the user selected any of the following options too: 1) KHTH_USE_FGNV_STREAMFUNCTION = True 2) USE_MEKE = True 3) KhTr_passivity_coeff > 0 4) MLE_front_length > 0 5) Output the diagnostic Rd_dx 6) Use resolution scaling for the a) Laplacian viscosity, b) interface height diffusivity, c) tracer diffusivity, OR d) the MEKE viscosity contribution. --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 47d1cd6eb3..aa561793e0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1194,7 +1194,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) default=1.0e-17, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) - CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn + CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn .or. CS%khth_use_ebt_struct CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE ! Indicate whether to calculate the Eady growth rate CS%calculate_Eady_growth_rate = use_MEKE .or. (KhTr_Slope_Cff>0.) .or. (KhTh_Slope_Cff>0.) From c6c84c8071a9e3a6b4b288ba4ddc32e128630ad4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Dec 2022 16:04:41 -0500 Subject: [PATCH 052/213] +Add units to 11 log_param calls Add appropriate units arguments to 11 log_param calls that were missing them. All answers are bitwise identical, but the logged output can change in some cases. --- src/core/MOM_PressureForce_FV.F90 | 2 +- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- src/core/MOM_barotropic.F90 | 4 ++-- src/core/MOM_verticalGrid.F90 | 6 +++--- src/framework/testing/MOM_file_parser_tests.F90 | 4 ++-- src/tracer/oil_tracer.F90 | 2 +- 6 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index a35effa5c0..5fdc4a1182 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -857,7 +857,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS CS%GFS_scale = 1.0 if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth - call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) + call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale, units="nondim") end subroutine PressureForce_FV_init diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 1ae4a8709a..424e9b1a32 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -874,7 +874,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ CS%GFS_scale = 1.0 if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth - call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) + call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale, units="nondim") end subroutine PressureForce_Mont_init diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5fd8a97793..105e81732a 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4804,8 +4804,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false. - call log_param(param_file, mdl, "DTBT as used", CS%dtbt*US%T_to_s) - call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max*US%T_to_s) + call log_param(param_file, mdl, "DTBT as used", CS%dtbt*US%T_to_s, units="s") + call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max*US%T_to_s, units="s") ! ubtav and vbtav, and perhaps ubt_IC and vbt_IC, are allocated and ! initialized in register_barotropic_restarts. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index e40ab20d5c..41d29488cd 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -176,9 +176,9 @@ subroutine verticalGridInit( param_file, GV, US ) GV%RZ_to_H = GV%kg_m2_to_H * US%R_to_kg_m3 * US%Z_to_m ! Log derivative values. - call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) - call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) - call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m) + call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor, units="H m-1") + call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H, units="2^n H m-1") + call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m, units="2^-n m H-1") allocate( GV%sInterface(nk+1) ) allocate( GV%sLayer(nk) ) diff --git a/src/framework/testing/MOM_file_parser_tests.F90 b/src/framework/testing/MOM_file_parser_tests.F90 index 673cef8c16..c0a31c39c4 100644 --- a/src/framework/testing/MOM_file_parser_tests.F90 +++ b/src/framework/testing/MOM_file_parser_tests.F90 @@ -1277,7 +1277,7 @@ subroutine test_log_param_real call create_test_file(param_filename) call open_param_file(param_filename, param) - call log_param(param, module_name, sample_param_name, sample, desc=desc) + call log_param(param, module_name, sample_param_name, sample, desc=desc, units="") call close_param_file(param) end subroutine test_log_param_real @@ -1290,7 +1290,7 @@ subroutine test_log_param_real_array call create_test_file(param_filename) call open_param_file(param_filename, param) - call log_param(param, module_name, sample_param_name, sample, desc=desc) + call log_param(param, module_name, sample_param_name, sample, desc=desc, units="") call close_param_file(param) end subroutine test_log_param_real_array diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 3fc2537caa..4d828decad 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -165,7 +165,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) endif endif enddo - call log_param(param_file, mdl, "OIL_DECAY_RATE", US%s_to_T*CS%oil_decay_rate(1:CS%ntr)) + call log_param(param_file, mdl, "OIL_DECAY_RATE", US%s_to_T*CS%oil_decay_rate(1:CS%ntr), units="s-1") ! This needs to be changed if the units of tracer are changed above. if (GV%Boussinesq) then ; flux_units = "kg s-1" From 74c0de65e82abe641db85a46f25734877c9203e6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 30 Nov 2022 12:48:03 -0500 Subject: [PATCH 053/213] +Rescaled time variables in all MOM6 drivers Dimensionally rescaled the internal variables with units of time in all of the top-level driver codes, from units of [s] to [T ~> s], including thing valid_time arguments to the various drivers' versions of convert_IOB_to_fluxes. All answers are bitwise identical in all cases that have been tested, although it should be noted that the mct_cap and nuopc_cap are not regularly tested as a part of the GFDL MOM6-examples test suite. These changes only apply to dimensional rescaling of timestep variables and the documentation of units. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 8 +- .../drivers/FMS_cap/ocean_model_MOM.F90 | 67 +++++++-------- .../ice_solo_driver/ice_shelf_driver.F90 | 21 +++-- .../drivers/mct_cap/mom_ocean_model_mct.F90 | 71 ++++++++-------- .../mct_cap/mom_surface_forcing_mct.F90 | 4 +- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 71 ++++++++-------- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 4 +- config_src/drivers/solo_driver/MOM_driver.F90 | 83 ++++++++++--------- src/core/MOM_forcing_type.F90 | 2 +- 9 files changed, 167 insertions(+), 164 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 90797027c6..ccd2183e3c 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -221,7 +221,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. real, intent(in) :: valid_time !< The amount of time over which these fluxes - !! should be applied [s]. + !! should be applied [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a @@ -333,7 +333,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Indicate that there are new unused fluxes. fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*valid_time + fluxes%dt_buoy_accum = valid_time fluxes%heat_added(:,:) = 0.0 fluxes%salt_flux_added(:,:) = 0.0 @@ -581,7 +581,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, US%s_to_T*valid_time, G, US, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, valid_time, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged @@ -663,7 +663,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ !! previous call to surface_forcing_init. real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the !! current value of ustar as a weighted running - !! average [s], or if 0 do not average ustar. + !! average [T ~> s], or if 0 do not average ustar. !! Missing is equivalent to 0. logical, optional, intent(in) :: reset_avg !< If true, reset the time average. diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index a12ab35240..f8f7de6eae 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -21,7 +21,7 @@ module ocean_model_mod use MOM_coupler_types, only : coupler_type_spawn, coupler_type_write_chksums use MOM_coupler_types, only : coupler_type_initialized, coupler_type_copy_data use MOM_coupler_types, only : coupler_type_set_diags, coupler_type_send_data -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : MOM_domain_type, domain2d, clone_MOM_domain, get_domain_extent use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE, TO_ALL, Omit_Corners @@ -171,8 +171,8 @@ module ocean_model_mod !! If false, the two phases are advanced with !! separate calls. The default is true. ! The following 3 variables are only used here if single_step_call is false. - real :: dt !< (baroclinic) dynamics time step [s] - real :: dt_therm !< thermodynamics time step [s] + real :: dt !< (baroclinic) dynamics time step [T ~> s] + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic @@ -293,16 +293,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that "//& - "is actually used will be an integer fraction of the "//& - "forcing time-step.", units="s", fail_if_missing=.true.) + "The (baroclinic) dynamics time step. The time-step that is actually "//& + "used will be an integer fraction of the forcing time-step.", & + units="s", scale=OS%US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & "The thermodynamic and tracer advection time step. "//& "Ideally DT_THERM should be an integer multiple of DT "//& "and less than the forcing or coupling time-step, unless "//& "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& "can be an integer multiple of the coupling timestep. By "//& - "default DT_THERM is set to DT.", units="s", default=OS%dt) + "default DT_THERM is set to DT.", & + units="s", scale=OS%US%s_to_T, default=OS%US%T_to_s*OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -462,11 +463,11 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda type(time_type) :: Time1 ! The value of the ocean model's time at the start of a call to step_MOM. integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocean boundary type. real :: weight ! Flux accumulation weight of the current fluxes. - real :: dt_coupling ! The coupling time step [s]. - real :: dt_therm ! A limited and quantized version of OS%dt_therm [s]. - real :: dt_dyn ! The dynamics time step [s]. - real :: dtdia ! The diabatic time step [s]. - real :: t_elapsed_seg ! The elapsed time in this update segment [s]. + real :: dt_coupling ! The coupling time step [T ~> s]. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s]. + real :: dt_dyn ! The dynamics time step [T ~> s]. + real :: dtdia ! The diabatic time step [T ~> s]. + real :: t_elapsed_seg ! The elapsed time in this update segment [T ~> s]. integer :: n ! The internal iteration counter. integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step. integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model. @@ -478,7 +479,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") - dt_coupling = time_type_to_real(Ocean_coupling_time_step) + dt_coupling = OS%US%s_to_T*time_type_to_real(Ocean_coupling_time_step) if (.not.associated(OS)) then call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & @@ -518,7 +519,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) if (OS%icebergs_alter_ocean) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) endif if (do_thermo) then @@ -528,13 +529,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! Add ice shelf fluxes if (OS%use_ice_shelf) & - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes call disable_averaging(OS%diag) #endif @@ -546,10 +547,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state) if (OS%use_ice_shelf) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) call fluxes_accumulate(OS%flux_tmp, OS%fluxes, OS%grid, weight) #ifdef _USE_GENERIC_TRACER @@ -579,15 +580,15 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda Time1 = Time_seg_start if (OS%offline_tracer_mode .and. do_thermo) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -609,18 +610,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -634,15 +635,15 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. - Time1 = Time1 - real_to_time(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & + Time1 = Time1 - real_to_time(OS%US%T_to_s*(dtdia - dt_dyn)) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) endif endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time1 = Time_seg_start + real_to_time(t_elapsed_seg) + Time1 = Time_seg_start + real_to_time(OS%US%T_to_s*t_elapsed_seg) enddo endif @@ -653,7 +654,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 if (do_dyn) then - call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time_dyn, OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, OS%US%T_to_s*dt_coupling, OS%grid, OS%Time_dyn, OS%diag, OS%forcing_CSp%handles) endif if (OS%fluxes%fluxes_used .and. do_thermo) then diff --git a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 index 959e4676d0..8ea0867d03 100644 --- a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 @@ -25,8 +25,7 @@ program Shelf_main use MOM_cpu_clock, only : CLOCK_COMPONENT use MOM_debugging, only : MOM_debugging_init use MOM_diag_mediator, only : diag_mediator_init, diag_mediator_infrastructure_init - use MOM_diag_mediator, only : enable_averaging, disable_averaging, diag_mediator_end - use MOM_diag_mediator, only : diag_ctrl, diag_mediator_close_registration + use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration use MOM_domains, only : MOM_infra_init, MOM_infra_end use MOM_domains, only : MOM_domains_init, clone_MOM_domain, pass_var use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid @@ -96,13 +95,13 @@ program Shelf_main type(time_type) :: time_chg ! An amount of time to adjust the segment_start_time ! and elapsed time to avoid roundoff problems. - real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. + real :: elapsed_time = 0.0 ! Elapsed time in this run [T ~> s]. logical :: elapsed_time_master ! If true, elapsed time is used to set the ! model's master clock (Time). This is needed ! if Time_step_shelf is not an exact ! representation of time_step. - real :: time_step ! The time step [s] + real :: time_step ! The time step [T ~> s] ! A pointer to a structure containing metrics and related information. type(ocean_grid_type), pointer :: ocn_grid @@ -232,7 +231,7 @@ program Shelf_main call get_param(param_file, mod_name, "ICE_VELOCITY_TIMESTEP", time_step, & "The time step for changing forcing, coupling with other "//& "components, or potentially writing certain diagnostics.", & - units="s", fail_if_missing=.true.) + units="s", scale=US%s_to_T, fail_if_missing=.true.) if (sum(date) >= 0) then ! In this case, the segment starts at a time fixed by ocean_solo.res @@ -282,8 +281,8 @@ program Shelf_main segment_start_time = Time elapsed_time = 0.0 - Time_step_shelf = real_to_time(time_step) - elapsed_time_master = (abs(time_step - time_type_to_real(Time_step_shelf)) > 1.0e-12*time_step) + Time_step_shelf = real_to_time(US%T_to_s*time_step) + elapsed_time_master = (abs(time_step - US%s_to_T*time_type_to_real(Time_step_shelf)) > 1.0e-12*time_step) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -384,18 +383,18 @@ program Shelf_main ! Time = Time + Time_step_shelf ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + time_step - if (elapsed_time > 2e9) then + if (elapsed_time > 2.0e9*US%s_to_T) then ! This is here to ensure that the conversion from a real to an integer can be accurately ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time ! does not lose resolution of order the timetype's resolution, provided that the timestep and ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller ! value would be required. - time_chg = real_to_time(elapsed_time) + time_chg = real_to_time(US%T_to_s*elapsed_time) segment_start_time = segment_start_time + time_chg - elapsed_time = elapsed_time - time_type_to_real(time_chg) + elapsed_time = elapsed_time - US%s_to_T*time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + real_to_time(elapsed_time) + Master_Time = segment_start_time + real_to_time(US%T_to_s*elapsed_time) else Master_Time = Master_Time + Time_step_shelf endif diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index c2ee910dbb..bdcefbc1b2 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -17,7 +17,7 @@ module MOM_ocean_model_mct use MOM, only : get_ocean_stocks, step_offline use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners @@ -170,8 +170,8 @@ module MOM_ocean_model_mct !! If false, the two phases are advanced with !! separate calls. The default is true. ! The following 3 variables are only used here if single_step_call is false. - real :: dt !< (baroclinic) dynamics time step (seconds) - real :: dt_therm !< thermodynamics time step (seconds) + real :: dt !< (baroclinic) dynamics time step [T ~> s] + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic @@ -285,16 +285,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that "//& - "is actually used will be an integer fraction of the "//& - "forcing time-step.", units="s", fail_if_missing=.true.) + "The (baroclinic) dynamics time step. The time-step that is actually "//& + "used will be an integer fraction of the forcing time-step.", & + units="s", scale=OS%US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & "The thermodynamic and tracer advection time step. "//& "Ideally DT_THERM should be an integer multiple of DT "//& "and less than the forcing or coupling time-step, unless "//& "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& "can be an integer multiple of the coupling timestep. By "//& - "default DT_THERM is set to DT.", units="s", default=OS%dt) + "default DT_THERM is set to DT.", & + units="s", scale=OS%US%s_to_T, default=OS%US%T_to_s*OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -448,13 +449,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: index_bnds(4) ! The computational domain index bounds in the ! ice-ocean boundary type. real :: weight ! Flux accumulation weight - real :: dt_coupling ! The coupling time step in seconds. + real :: dt_coupling ! The coupling time step [T ~> s] integer :: nts ! The number of baroclinic dynamics time steps ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s] + real :: dt_dyn ! The dynamics time step [T ~> s] + real :: dtdia ! The diabatic time step [T ~> s] + real :: t_elapsed_seg ! The elapsed time in this update segment [T ~> s] integer :: n, n_max, n_last_thermo type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans @@ -467,7 +468,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call callTree_enter("update_ocean_model(), MOM_ocean_model_mct.F90") call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) + dt_coupling = OS%US%s_to_T*(86400.0*real(days) + real(secs)) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -501,7 +502,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then ! GMM, is enable_averaging needed now? - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, dt_coupling, & @@ -511,24 +512,24 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes #endif @@ -542,17 +543,17 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, OS%grid, weight) @@ -581,16 +582,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if(OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) @@ -614,18 +615,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -639,22 +640,22 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + Time2 = Time2 - set_time(int(floor(OS%US%T_to_s*(dtdia - dt_dyn) + 0.5))) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) endif endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + set_time(int(floor(OS%US%T_to_s*t_elapsed_seg + 0.5))) enddo endif OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, OS%US%T_to_s*dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) if (OS%fluxes%fluxes_used) then call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, OS%forcing_CSp%handles) diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index 78f7bad268..8644e85616 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -206,7 +206,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. real, intent(in) :: valid_time !< The amount of time over which these fluxes - !! should be applied [s]. + !! should be applied [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a @@ -334,7 +334,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Indicate that there are new unused fluxes. fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*valid_time + fluxes%dt_buoy_accum = valid_time if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:) = 0.0 diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 1fb35b31a6..640fc32632 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -17,7 +17,7 @@ module MOM_ocean_model_nuopc use MOM, only : get_ocean_stocks, step_offline use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners @@ -171,7 +171,7 @@ module MOM_ocean_model_nuopc !! separate calls. The default is true. ! The following 3 variables are only used here if single_step_call is false. real :: dt !< (baroclinic) dynamics time step (seconds) - real :: dt_therm !< thermodynamics time step (seconds) + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic @@ -295,16 +295,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that "//& - "is actually used will be an integer fraction of the "//& - "forcing time-step.", units="s", fail_if_missing=.true.) + "The (baroclinic) dynamics time step. The time-step that is actually "//& + "used will be an integer fraction of the forcing time-step.", & + units="s", scale=OS%US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & "The thermodynamic and tracer advection time step. "//& "Ideally DT_THERM should be an integer multiple of DT "//& "and less than the forcing or coupling time-step, unless "//& "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& "can be an integer multiple of the coupling timestep. By "//& - "default DT_THERM is set to DT.", units="s", default=OS%dt) + "default DT_THERM is set to DT.", & + units="s", default=OS%US%T_to_s*OS%dt, scale=OS%US%s_to_T) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -489,13 +490,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: index_bnds(4) ! The computational domain index bounds in the ! ice-ocean boundary type. real :: weight ! Flux accumulation weight - real :: dt_coupling ! The coupling time step in seconds. + real :: dt_coupling ! The coupling time step in rescaled seconds [T ~> s]. integer :: nts ! The number of baroclinic dynamics time steps ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s] + real :: dt_dyn ! The dynamics time step [T ~> s] + real :: dtdia ! The diabatic time step [T ~> s] + real :: t_elapsed_seg ! The elapsed time in this update segment [T ~> s] integer :: n, n_max, n_last_thermo type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans @@ -508,7 +509,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call callTree_enter("update_ocean_model(), MOM_ocean_model_nuopc.F90") call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) + dt_coupling = OS%US%s_to_T*(86400.0*real(days) + real(secs)) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -547,45 +548,45 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes #endif else OS%flux_tmp%C_p = OS%fluxes%C_p if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, dt_coupling, & - OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, OS%restore_temp) if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, OS%grid, weight) @@ -614,16 +615,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if (OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) - !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -646,18 +647,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -671,22 +672,22 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + Time2 = Time2 - set_time(int(floor(OS%US%T_to_s*(dtdia - dt_dyn) + 0.5))) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) endif endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + set_time(int(floor(OS%US%T_to_s*t_elapsed_seg + 0.5))) enddo endif OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, OS%US%T_to_s*dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) if (OS%fluxes%fluxes_used) then if (cesm_coupled) then diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 738866c8ef..e2710bd18c 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -233,7 +233,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. real, intent(in) :: valid_time !< The amount of time over which these fluxes - !! should be applied [s]. + !! should be applied [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a @@ -363,7 +363,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Indicate that there are new unused fluxes. fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*valid_time + fluxes%dt_buoy_accum = valid_time if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 1d603740a1..565948af8b 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -27,8 +27,7 @@ program MOM6 use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT use MOM_data_override, only : data_override_init - use MOM_diag_mediator, only : enable_averaging, disable_averaging, diag_mediator_end - use MOM_diag_mediator, only : diag_ctrl, diag_mediator_close_registration + use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized @@ -122,20 +121,18 @@ program MOM6 type(time_type) :: Time_step_ocean ! A time_type version of dt_forcing. logical :: segment_start_time_set ! True if segment_start_time has been set to a valid value. - real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. - logical :: elapsed_time_master ! If true, elapsed time is used to set the - ! model's master clock (Time). This is needed - ! if Time_step_ocean is not an exact - ! representation of dt_forcing. - real :: dt_forcing ! The coupling time step [s]. - real :: dt ! The nominal baroclinic dynamics time step [s]. - integer :: ntstep ! The number of baroclinic dynamics time steps - ! within dt_forcing. - real :: dt_therm ! The thermodynamic timestep [s] - real :: dt_dyn ! The actual dynamic timestep used [s]. The value of dt_dyn is - ! chosen so that dt_forcing is an integer multiple of dt_dyn. - real :: dtdia ! The diabatic timestep [s] - real :: t_elapsed_seg ! The elapsed time in this run segment [s] + real :: elapsed_time = 0.0 ! Elapsed time in this run [T ~> s]. + logical :: elapsed_time_master ! If true, elapsed time is used to set the model's master + ! clock (Time). This is needed if Time_step_ocean is not + ! an exact representation of dt_forcing. + real :: dt_forcing ! The coupling time step [T ~> s]. + real :: dt ! The nominal baroclinic dynamics time step [T ~> s]. + integer :: ntstep ! The number of baroclinic dynamics time steps within dt_forcing. + real :: dt_therm ! The thermodynamic timestep [T ~> s] + real :: dt_dyn ! The actual dynamic timestep used [T ~> s]. The value of dt_dyn + ! is chosen so that dt_forcing is an integer multiple of dt_dyn. + real :: dtdia ! The diabatic timestep [T ~> s] + real :: t_elapsed_seg ! The elapsed time in this run segment [T ~> s] integer :: n, ns, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call type(time_type) :: Time2, time_chg ! Temporary time variables @@ -331,25 +328,28 @@ program MOM6 ! Read all relevant parameters and write them to the model log. call log_version(param_file, mod_name, version, "") - call get_param(param_file, mod_name, "DT", dt, fail_if_missing=.true.) + call get_param(param_file, mod_name, "DT", dt, & + units="s", scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mod_name, "DT_FORCING", dt_forcing, & "The time step for changing forcing, coupling with other "//& "components, or potentially writing certain diagnostics. "//& - "The default value is given by DT.", units="s", default=dt) + "The default value is given by DT.", & + units="s", default=US%T_to_s*dt, scale=US%s_to_T) if (offline_tracer_mode) then call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & "Length of time between reading in of input fields", & - units='s', fail_if_missing=.true.) + units="s", scale=US%s_to_T, fail_if_missing=.true.) dt = dt_forcing endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = real_to_time(dt_forcing) - elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) + Time_step_ocean = real_to_time(US%T_to_s*dt_forcing) + elapsed_time_master = (abs(dt_forcing - US%s_to_T*time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) ! Determine the segment end time, either from the namelist file or parsed input file. + ! Note that Time_unit always is in [s]. call get_param(param_file, mod_name, "TIMEUNIT", Time_unit, & "The time unit for DAYMAX, ENERGYSAVEDAYS, and RESTINT.", & units="s", default=86400.0) @@ -384,7 +384,8 @@ program MOM6 "and less than the forcing or coupling time-step, unless "//& "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& "can be an integer multiple of the coupling timestep. By "//& - "default DT_THERM is set to DT.", units="s", default=dt) + "default DT_THERM is set to DT.", & + units="s", default=US%T_to_s*dt, scale=US%s_to_T) call get_param(param_file, mod_name, "DIABATIC_FIRST", diabatic_first, & "If true, apply diabatic and thermodynamic processes, "//& "including buoyancy forcing and mass gain or loss, "//& @@ -461,11 +462,11 @@ program MOM6 endif if (use_ice_shelf) then - call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) + call shelf_calc_flux(sfc_state, fluxes, Time, US%T_to_s*dt_forcing, ice_shelf_CSp) call add_shelf_forces(grid, US, Ice_shelf_CSp, forces, external_call=.true.) endif fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*dt_forcing + fluxes%dt_buoy_accum = dt_forcing if (use_waves) then call Update_Surface_Waves(grid, GV, US, time, time_step_ocean, waves_csp) @@ -478,9 +479,9 @@ program MOM6 ! This call steps the model over a time dt_forcing. Time1 = Master_Time ; Time = Master_Time if (offline_tracer_mode) then - call step_offline(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp) + call step_offline(forces, fluxes, sfc_state, Time1, US%T_to_s*dt_forcing, MOM_CSp) elseif (single_step_call) then - call step_MOM(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) + call step_MOM(forces, fluxes, sfc_state, Time1, US%T_to_s*dt_forcing, MOM_CSp, Waves=Waves_CSP) else n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) dt_dyn = dt_forcing / real(n_max) @@ -493,51 +494,51 @@ program MOM6 if (diabatic_first) then if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(ntstep,n_max-(n-1)) - call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) + start_cycle=(n==1), end_cycle=.false., cycle_length=US%T_to_s*dt_forcing) endif - call step_MOM(forces, fluxes, sfc_state, Time2, dt_dyn, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dt_dyn, MOM_CSp, & do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=US%T_to_s*dt_forcing) else - call step_MOM(forces, fluxes, sfc_state, Time2, dt_dyn, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dt_dyn, MOM_CSp, & do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) + start_cycle=(n==1), end_cycle=.false., cycle_length=US%T_to_s*dt_forcing) if ((modulo(n,nts)==0) .or. (n==n_max)) then dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - real_to_time(dtdia - dt_dyn) - call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & + Time2 = Time2 - real_to_time(US%T_to_s*(dtdia - dt_dyn)) + call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=US%T_to_s*dt_forcing) n_last_thermo = n endif endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + real_to_time(t_elapsed_seg) + Time2 = Time1 + real_to_time(US%T_to_s*t_elapsed_seg) enddo endif ! Time = Time + Time_step_ocean ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + dt_forcing - if (elapsed_time > 2e9) then + if (elapsed_time > 2.0e9*US%s_to_T) then ! This is here to ensure that the conversion from a real to an integer can be accurately ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time ! does not lose resolution of order the timetype's resolution, provided that the timestep and ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller ! value would be required. - time_chg = real_to_time(elapsed_time) + time_chg = real_to_time(US%T_to_s*elapsed_time) segment_start_time = segment_start_time + time_chg - elapsed_time = elapsed_time - time_type_to_real(time_chg) + elapsed_time = elapsed_time - US%s_to_T*time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + real_to_time(elapsed_time) + Master_Time = segment_start_time + real_to_time(US%T_to_s*elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif @@ -547,7 +548,7 @@ program MOM6 call write_cputime(Time, ns+ntstep-1, write_CPU_CSp, nmax) endif ; endif - call mech_forcing_diags(forces, dt_forcing, grid, Time, diag, surface_forcing_CSp%handles) + call mech_forcing_diags(forces, US%T_to_s*dt_forcing, grid, Time, diag, surface_forcing_CSp%handles) if (.not. offline_tracer_mode) then if (fluxes%fluxes_used) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4365dd6296..ace61b3ed9 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -255,7 +255,7 @@ module MOM_forcing_type rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at !! v-points [L4 Z-1 T-1 ~> m3 s-1] real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes - !! have been averaged [s]. + !! have been averaged [T ~> s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the From 60c1d7b81cd0dca98e1b968c57140f68eda1168c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 30 Nov 2022 15:48:00 -0500 Subject: [PATCH 054/213] +Rescaled real time arguments to step_MOM Rescaled the dimensions of real time arguments to step_MOM and several other MOM routines that are called from the driver code, including shelf_calc_flux, iceberg_forces, iceberg_fluxes and step_offline, along with the routines offline_advection_ale and offline_advection_layer that are called subsequently. As a part of the development of this commit, it was found that one of the scaling factors for setting fluxes%ustar_berg was missing with the mct_cap, and this has been corrected. All answers and output are bitwise identical, but the scaling for several arguments in publicly visible interfaces have changed. --- .../drivers/FMS_cap/ocean_model_MOM.F90 | 42 +++++++++++-------- .../drivers/mct_cap/mom_ocean_model_mct.F90 | 36 ++++++++-------- .../mct_cap/mom_surface_forcing_mct.F90 | 2 +- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 38 ++++++++--------- config_src/drivers/solo_driver/MOM_driver.F90 | 24 +++++------ .../solo_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM.F90 | 20 ++++----- src/core/MOM_forcing_type.F90 | 6 +-- src/ice_shelf/MOM_ice_shelf.F90 | 22 +++++----- src/ice_shelf/MOM_marine_ice.F90 | 6 +-- src/tracer/MOM_offline_main.F90 | 6 +-- 11 files changed, 105 insertions(+), 99 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index f8f7de6eae..049ae3d3df 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -519,7 +519,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) if (OS%icebergs_alter_ocean) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif if (do_thermo) then @@ -529,10 +529,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! Add ice shelf fluxes if (OS%use_ice_shelf) & - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) #ifdef _USE_GENERIC_TRACER call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? @@ -547,10 +547,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state) if (OS%use_ice_shelf) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time,dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) call fluxes_accumulate(OS%flux_tmp, OS%fluxes, OS%grid, weight) #ifdef _USE_GENERIC_TRACER @@ -580,15 +580,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda Time1 = Time_seg_start if (OS%offline_tracer_mode .and. do_thermo) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, & + if (present(cycle_length)) then + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & - start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & + start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=OS%US%s_to_T*cycle_length, & reset_therm=Ocn_fluxes_used) + else + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & + start_cycle=start_cycle, end_cycle=end_cycle, reset_therm=Ocn_fluxes_used) + endif elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -610,18 +616,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -636,9 +642,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. Time1 = Time1 - real_to_time(OS%US%T_to_s*(dtdia - dt_dyn)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif @@ -654,7 +660,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 if (do_dyn) then - call mech_forcing_diags(OS%forces, OS%US%T_to_s*dt_coupling, OS%grid, OS%Time_dyn, OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time_dyn, OS%diag, OS%forcing_CSp%handles) endif if (OS%fluxes%fluxes_used .and. do_thermo) then diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index bdcefbc1b2..1a15760d00 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -512,17 +512,17 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. @@ -543,17 +543,17 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, OS%grid, weight) @@ -582,16 +582,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if(OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) @@ -615,18 +615,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -641,9 +641,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. Time2 = Time2 - set_time(int(floor(OS%US%T_to_s*(dtdia - dt_dyn) + 0.5))) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif @@ -655,7 +655,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call mech_forcing_diags(OS%forces, OS%US%T_to_s*dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) if (OS%fluxes%fluxes_used) then call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, OS%forcing_CSp%handles) diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index 8644e85616..b34f1a3b35 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -444,7 +444,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, end if if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 640fc32632..199ca27b49 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -548,17 +548,17 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. @@ -576,17 +576,17 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%use_ice_shelf) then if (do_thermo) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, OS%US%T_to_s*dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, OS%US%T_to_s*dt_coupling, OS%marine_ice_CSp) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, OS%grid, weight) @@ -615,16 +615,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if (OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) - !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, OS%US%T_to_s*dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -647,18 +647,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -673,9 +673,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. Time2 = Time2 - set_time(int(floor(OS%US%T_to_s*(dtdia - dt_dyn) + 0.5))) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, OS%US%T_to_s*dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=OS%US%T_to_s*dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif @@ -687,7 +687,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call mech_forcing_diags(OS%forces, OS%US%T_to_s*dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) if (OS%fluxes%fluxes_used) then if (cesm_coupled) then diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 565948af8b..974843c10f 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -462,7 +462,7 @@ program MOM6 endif if (use_ice_shelf) then - call shelf_calc_flux(sfc_state, fluxes, Time, US%T_to_s*dt_forcing, ice_shelf_CSp) + call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) call add_shelf_forces(grid, US, Ice_shelf_CSp, forces, external_call=.true.) endif fluxes%fluxes_used = .false. @@ -479,9 +479,9 @@ program MOM6 ! This call steps the model over a time dt_forcing. Time1 = Master_Time ; Time = Master_Time if (offline_tracer_mode) then - call step_offline(forces, fluxes, sfc_state, Time1, US%T_to_s*dt_forcing, MOM_CSp) + call step_offline(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp) elseif (single_step_call) then - call step_MOM(forces, fluxes, sfc_state, Time1, US%T_to_s*dt_forcing, MOM_CSp, Waves=Waves_CSP) + call step_MOM(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) else n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) dt_dyn = dt_forcing / real(n_max) @@ -494,27 +494,27 @@ program MOM6 if (diabatic_first) then if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(ntstep,n_max-(n-1)) - call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dtdia, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=US%T_to_s*dt_forcing) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) endif - call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dt_dyn, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, dt_dyn, MOM_CSp, & do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=US%T_to_s*dt_forcing) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) else - call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dt_dyn, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, dt_dyn, MOM_CSp, & do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=US%T_to_s*dt_forcing) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) if ((modulo(n,nts)==0) .or. (n==n_max)) then dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & Time2 = Time2 - real_to_time(US%T_to_s*(dtdia - dt_dyn)) - call step_MOM(forces, fluxes, sfc_state, Time2, US%T_to_s*dtdia, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=US%T_to_s*dt_forcing) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) n_last_thermo = n endif endif @@ -548,7 +548,7 @@ program MOM6 call write_cputime(Time, ns+ntstep-1, write_CPU_CSp, nmax) endif ; endif - call mech_forcing_diags(forces, US%T_to_s*dt_forcing, grid, Time, diag, surface_forcing_CSp%handles) + call mech_forcing_diags(forces, dt_forcing, grid, Time, diag, surface_forcing_CSp%handles) if (.not. offline_tracer_mode) then if (fluxes%fluxes_used) then diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 7fab9e5c8c..3ad06ddb8e 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -1300,7 +1300,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, US%T_to_s*dt, G, US, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, dt, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b20940aeba..6c978b36f5 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -481,7 +481,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS !! tracer and mass exchange forcing fields type(surface), target, intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. + real, intent(in) :: time_int_in !< time interval covered by this run segment [T ~> s]. type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM type(Wave_parameters_CS), & optional, pointer :: Waves !< An optional pointer to a wave property CS @@ -496,7 +496,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS !! treated as the last call to step_MOM in a !! time-stepping cycle; missing is like true. real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time - !! stepping cycle [s]. + !! stepping cycle [T ~> s]. logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. @@ -566,14 +566,14 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB u => CS%u ; v => CS%v ; h => CS%h - time_interval = US%s_to_T*time_int_in + time_interval = time_int_in do_dyn = .true. ; if (present(do_dynamics)) do_dyn = do_dynamics do_thermo = .true. ; if (present(do_thermodynamics)) do_thermo = do_thermodynamics if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL,"Step_MOM: "//& "Both do_dynamics and do_thermodynamics are false, which makes no sense.") cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle - cycle_time = time_interval ; if (present(cycle_length)) cycle_time = US%s_to_T*cycle_length + cycle_time = time_interval ; if (present(cycle_length)) cycle_time = cycle_length therm_reset = cycle_start ; if (present(reset_therm)) therm_reset = reset_therm call cpu_clock_begin(id_clock_ocean) @@ -629,7 +629,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ntstep = floor(dt_therm/dt + 0.001) elseif (.not.do_thermo) then dt_therm = CS%dt_therm - if (present(cycle_length)) dt_therm = min(CS%dt_therm, US%s_to_T*cycle_length) + if (present(cycle_length)) dt_therm = min(CS%dt_therm, cycle_length) ! ntstep is not used. else ntstep = MAX(1, MIN(n_max, floor(CS%dt_therm/dt + 0.001))) @@ -1649,7 +1649,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval [s] + real, intent(in) :: time_interval !< time interval [T ~> s] type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM ! Local pointers @@ -1695,9 +1695,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call cpu_clock_begin(id_clock_offline_tracer) call extract_offline_main(CS%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, & vertical_time, dt_offline, dt_offline_vertical, skip_diffusion) - Time_end = increment_date(Time_start, seconds=floor(time_interval+0.001)) + Time_end = increment_date(Time_start, seconds=floor(US%T_to_s*time_interval+0.001)) - call enable_averaging(time_interval, Time_end, CS%diag) + call enable_averages(time_interval, Time_end, CS%diag) ! Check to see if this is the first iteration of the offline interval first_iter = (accumulated_time == real_to_time(0.0)) @@ -1707,7 +1707,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (do_vertical) vertical_time = accumulated_time + real_to_time(US%T_to_s*dt_offline_vertical) ! Increment the amount of time elapsed since last read and check if it's time to roll around - accumulated_time = accumulated_time + real_to_time(time_interval) + accumulated_time = accumulated_time + real_to_time(US%T_to_s*time_interval) last_iter = (accumulated_time >= real_to_time(US%T_to_s*dt_offline)) @@ -1814,7 +1814,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in ! main_offline_advection_layer. Warning: this may not be appropriate for tracers that ! exchange with the atmosphere - if (abs(time_interval - US%T_to_s*dt_offline) > 1.0e-6) then + if (abs(time_interval - dt_offline) > 1.0e-6*US%s_to_T) then call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index ace61b3ed9..f005ac1a0e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -10,7 +10,7 @@ module MOM_forcing_type use MOM_debugging, only : hchksum, uvchksum use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled -use MOM_diag_mediator, only : enable_averages, enable_averaging, disable_averaging +use MOM_diag_mediator, only : enable_averages, disable_averaging use MOM_EOS, only : calculate_density_derivs, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -2310,7 +2310,7 @@ end subroutine copy_back_forcing_fields !! fields registered as part of register_forcing_type_diags. subroutine mech_forcing_diags(forces_in, dt, G, time_end, diag, handles) type(mech_forcing), target, intent(in) :: forces_in !< mechanical forcing input fields - real, intent(in) :: dt !< time step for the forcing [s] + real, intent(in) :: dt !< time step for the forcing [T ~> s] type(ocean_grid_type), intent(in) :: G !< grid type type(time_type), intent(in) :: time_end !< The end time of the diagnostic interval. type(diag_ctrl), intent(inout) :: diag !< diagnostic type @@ -2335,7 +2335,7 @@ subroutine mech_forcing_diags(forces_in, dt, G, time_end, diag, handles) endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - call enable_averaging(dt, time_end, diag) + call enable_averages(dt, time_end, diag) ! if (query_averaging_enabled(diag)) then if ((handles%id_taux > 0) .and. associated(forces%taux)) & diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index ab73675bb1..bde8e3e219 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -220,16 +220,16 @@ module MOM_ice_shelf !! formulation (optional to use just two equations). !! See \ref section_ICE_SHELF_equations subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) - type(surface), target, intent(inout) :: sfc_state_in !< A structure containing fields that - !! describe the surface state of the ocean. The - !! intent is only inout to allow for halo updates. - type(forcing), target, intent(inout) :: fluxes_in !< structure containing pointers to any - !! possible thermodynamic or mass-flux forcing fields. - type(time_type), intent(in) :: Time !< Start time of the fluxes. - real, intent(in) :: time_step_in !< Length of time over which these fluxes - !! will be applied [s]. - type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure returned - !! by a previous call to initialize_ice_shelf. + type(surface), target, intent(inout) :: sfc_state_in !< A structure containing fields that + !! describe the surface state of the ocean. The + !! intent is only inout to allow for halo updates. + type(forcing), target, intent(inout) :: fluxes_in !< structure containing pointers to any + !! possible thermodynamic or mass-flux forcing fields. + type(time_type), intent(in) :: Time !< Start time of the fluxes. + real, intent(in) :: time_step_in !< Length of time over which these fluxes + !! will be applied [T ~> s]. + type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to initialize_ice_shelf. ! Local variables type(ocean_grid_type), pointer :: G => NULL() !< The grid structure used by the ice shelf. @@ -326,7 +326,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) G => CS%grid ; US => CS%US ISS => CS%ISS - time_step = US%s_to_T*time_step_in + time_step = time_step_in if (CS%data_override_shelf_fluxes .and. CS%active_shelf_dynamics) then call data_override(G%Domain, 'shelf_sfc_mass_flux', fluxes_in%shelf_sfc_mass_flux, CS%Time, & diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index f24f9b1881..2a1b6d799b 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -48,7 +48,7 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, time_step, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: time_step !< The coupling time step [s]. + real, intent(in) :: time_step !< The coupling time step [T ~> s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice real :: kv_rho_ice ! The viscosity of ice divided by its density [L4 Z-2 T-1 R-1 ~> m5 kg-1 s-1]. @@ -106,7 +106,7 @@ subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, time_step, CS type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: time_step !< The coupling time step [s]. + real, intent(in) :: time_step !< The coupling time step [T ~> s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice real :: fraz ! refreezing rate [R Z T-1 ~> kg m-2 s-1] @@ -138,7 +138,7 @@ subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, time_step, CS !Zero'ing out other fluxes under the tabular icebergs if (CS%berg_area_threshold >= 0.) then - I_dt_LHF = 1.0 / (US%s_to_T*time_step * CS%latent_heat_fusion) + I_dt_LHF = 1.0 / (time_step * CS%latent_heat_fusion) do j=jsd,jed ; do i=isd,ied if (fluxes%frac_shelf_h(i,j) > CS%berg_area_threshold) then ! Only applying for ice shelf covering most of cell. diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index bf06fc294e..2200a28c2b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -205,7 +205,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C h_pre, uhtr, vhtr, converged) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval covered by this call [s] + real, intent(in) :: time_interval !< time interval covered by this call [T ~> s] type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -846,7 +846,7 @@ end subroutine offline_fw_fluxes_out_ocean subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS, h_pre, eatr, ebtr, uhtr, vhtr) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< Offline transport time interval [s] + real, intent(in) :: time_interval !< Offline transport time interval [T ~> s] type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -894,7 +894,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - dt_iter = US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) + dt_iter = time_interval / real(max(1, CS%num_off_iter)) x_before_y = CS%x_before_y do iter=1,CS%num_off_iter From 8ddd8543175af95b01d076bc035c5bdea5abe3b4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Dec 2022 07:30:58 -0500 Subject: [PATCH 055/213] +Specify CVMix parameter units and rescale CVMix Specify the units of 5 parameters and applied dimensional rescaling to 14 MIN_THICKNESS or other length or viscosity parameters used in the CVMix code to appropriate units like [Z ~> m] or [Z2 T-1 ~> m2 s-1], with related changes to the rescaled units of several other internal variables. Also added comments describing a number of internal variables and their units in the MOM_CVMix and MOM_tidal_mixing code. The preliminary internal calculations in these routines now work in these [Z ~> m] units a bit longer before being recast into MKS units for the calls to the CVMix routines. The unused KPP runtime parameters CORRECT_SURFACE_LAYER_AVERAGE and FIRST_GUESS_SURFACE_LAYER_DEPTH have been marked as obsolete in comments of the code since 2015, and have now been formally obsoleted. All answers are bitwise identical, but there are changes to some MOM_parameter_doc files. --- src/diagnostics/MOM_obsolete_params.F90 | 3 +- .../vertical/MOM_CVMix_KPP.F90 | 316 +++++++++--------- .../vertical/MOM_CVMix_conv.F90 | 45 +-- .../vertical/MOM_CVMix_ddiff.F90 | 45 +-- .../vertical/MOM_CVMix_shear.F90 | 30 +- .../vertical/MOM_tidal_mixing.F90 | 58 ++-- 6 files changed, 248 insertions(+), 249 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index e686261fdf..19f3d87429 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -83,7 +83,8 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "ETA_TOLERANCE_AUX", only_warn=.true.) call obsolete_real(param_file, "BT_MASS_SOURCE_LIMIT", 0.0) - + call obsolete_real(param_file, "FIRST_GUESS_SURFACE_LAYER_DEPTH") + call obsolete_logical(param_file, "CORRECT_SURFACE_LAYER_AVERAGE") call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 1e068509b1..d73bba1551 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -73,10 +73,10 @@ module MOM_CVMix_KPP type, public :: KPP_CS ; private ! Parameters - real :: Ri_crit !< Critical bulk Richardson number (defines OBL depth) - real :: vonKarman !< von Karman constant (dimensionless) - real :: cs !< Parameter for computing velocity scale function (dimensionless) - real :: cs2 !< Parameter for multiplying by non-local term + real :: Ri_crit !< Critical bulk Richardson number (defines OBL depth) [nondim] + real :: vonKarman !< von Karman constant (dimensionless) [nondim] + real :: cs !< Parameter for computing velocity scale function (dimensionless) [nondim] + real :: cs2 !< Parameter for multiplying by non-local term [nondim] ! This is active for NLT_SHAPE_CUBIC_LMD only logical :: enhance_diffusion !< If True, add enhanced diffusivity at base of boundary layer. character(len=32) :: interpType !< Type of interpolation to compute bulk Richardson number @@ -85,12 +85,13 @@ module MOM_CVMix_KPP logical :: computeMoninObukhov !< If True, compute Monin-Obukhov limit for OBLdepth logical :: passiveMode !< If True, makes KPP passive meaning it does NOT alter the diffusivity real :: deepOBLoffset !< If non-zero, is a distance from the bottom that the OBL can not - !! penetrate through [m] - real :: minOBLdepth !< If non-zero, is a minimum depth for the OBL [m] + !! penetrate through [Z ~> m] + real :: minOBLdepth !< If non-zero, is a minimum depth for the OBL [Z ~> m] real :: surf_layer_ext !< Fraction of OBL depth considered in the surface layer [nondim] - real :: minVtsqr !< Min for the squared unresolved velocity used in Rib CVMix calculation [m2 s-2] + real :: minVtsqr !< Min for the squared unresolved velocity used in Rib CVMix + !! calculation [L2 T-2 ~> m2 s-2] logical :: fixedOBLdepth !< If True, will fix the OBL depth at fixedOBLdepth_value - real :: fixedOBLdepth_value !< value for the fixed OBL depth when fixedOBLdepth==True. + real :: fixedOBLdepth_value !< value for the fixed OBL depth when fixedOBLdepth==True [Z ~> m] logical :: debug !< If True, calculate checksums and write debugging information character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function @@ -103,21 +104,17 @@ module MOM_CVMix_KPP !! If False, will replace initial diffusivity wherever KPP diffusivity !! is non-zero. real :: min_thickness !< A minimum thickness used to avoid division by small numbers - !! in the vicinity of vanished layers. - ! smg: obsolete below - logical :: correctSurfLayerAvg !< If true, applies a correction to the averaging of surface layer properties - real :: surfLayerDepth !< A guess at the depth of the surface layer (which should 0.1 of OBLdepth) [m] - ! smg: obsolete above + !! in the vicinity of vanished layers [Z ~> m] integer :: SW_METHOD !< Sets method for using shortwave radiation in surface buoyancy flux logical :: LT_K_Enhancement !< Flags if enhancing mixing coefficients due to LT integer :: LT_K_Shape !< Integer for constant or shape function enhancement integer :: LT_K_Method !< Integer for mixing coefficients LT method - real :: KPP_K_ENH_FAC !< Factor to multiply by K if Method is CONSTANT + real :: KPP_K_ENH_FAC !< Factor to multiply by K if Method is CONSTANT [nondim] logical :: LT_Vt2_Enhancement !< Flags if enhancing Vt2 due to LT integer :: LT_VT2_METHOD !< Integer for Vt2 LT method - real :: KPP_VT2_ENH_FAC !< Factor to multiply by VT2 if Method is CONSTANT + real :: KPP_VT2_ENH_FAC !< Factor to multiply by VT2 if Method is CONSTANT [nondim] logical :: STOKES_MIXING !< Flag if model is mixing down Stokes gradient - !! This is relavent for which current to use in RiB + !! This is relevant for which current to use in RiB !> CVMix parameters type(CVMix_kpp_params_type), pointer :: KPP_params => NULL() @@ -143,15 +140,15 @@ module MOM_CVMix_KPP !>@} ! Diagnostics arrays - real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL [m] + real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of ocean boundary layer (OBL) [m] real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [m] without smoothing - real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent + real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent [nondim] real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [m] - real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP + real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP [nondim] real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [R ~> kg m-3] real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [m2 s-2] - real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) - real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) + real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer [nondim] + real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) [nondim] real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [m s-1] real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [s-1] real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] @@ -161,10 +158,10 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [m2 s-1] real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [C ~> degC] real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [S ~> ppt] - real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [m s-1] - real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [m s-1] - real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient - real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 + real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [L T-1 ~> m s-1] + real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [L T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient [nondim] + real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 [nondim] end type KPP_CS @@ -194,8 +191,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) # include "version_variable.h" character(len=40) :: mdl = 'MOM_CVMix_KPP' !< name of this module character(len=20) :: string !< local temporary string - character(len=20) :: langmuir_mixing_opt = 'NONE' !< langmuir mixing opt to be passed to CVMix, e.g., LWF16 - character(len=20) :: langmuir_entrainment_opt = 'NONE' !< langmuir entrainment opt to be passed to CVMix, e.g., LWF16 + character(len=20) :: langmuir_mixing_opt = 'NONE' !< Langmuir mixing option to be passed to CVMix, e.g., LWF16 + character(len=20) :: langmuir_entrainment_opt = 'NONE' !< Langmuir entrainment option to be + !! passed to CVMix, e.g., LWF16 logical :: CS_IS_ONE=.false. !< Logical for setting Cs based on Non-local logical :: lnoDGat1=.false. !< True => G'(1) = 0 (shape function) !! False => compute G'(1) as in LMD94 @@ -228,8 +226,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) call get_param(paramFile, mdl, 'N_SMOOTH', CS%n_smooth, & - 'The number of times the 1-1-4-1-1 Laplacian filter is applied on '// & - 'OBL depth.', & + 'The number of times the 1-1-4-1-1 Laplacian filter is applied on OBL depth.', & default=0) if (CS%n_smooth > G%domain%nihalo) then call MOM_error(FATAL,'KPP smoothing number (N_SMOOTH) cannot be greater than NIHALO.') @@ -277,7 +274,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) call get_param(paramFile, mdl, 'DEEP_OBL_OFFSET', CS%deepOBLoffset, & 'If non-zero, the distance above the bottom to which the OBL is clipped '// & 'if it would otherwise reach the bottom. The smaller of this and 0.1D is used.', & - units='m',default=0.) + units='m', default=0., scale=US%m_to_Z) call get_param(paramFile, mdl, 'FIXED_OBLDEPTH', CS%fixedOBLdepth, & 'If True, fix the OBL depth to FIXED_OBLDEPTH_VALUE '// & 'rather than using the OBL depth from CVMix. '// & @@ -287,32 +284,18 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Value for the fixed OBL depth when fixedOBLdepth==True. '// & 'This parameter is for just for testing purposes. '// & 'It will over-ride the OBLdepth computed from CVMix.', & - units='m',default=30.0) + units='m', default=30.0, scale=US%m_to_Z) call get_param(paramFile, mdl, 'SURF_LAYER_EXTENT', CS%surf_layer_ext, & 'Fraction of OBL depth considered in the surface layer.', & - units='nondim',default=0.10) + units='nondim', default=0.10) call get_param(paramFile, mdl, 'MINIMUM_OBL_DEPTH', CS%minOBLdepth, & 'If non-zero, a minimum depth to use for KPP OBL depth. Independent of '// & 'this parameter, the OBL depth is always at least as deep as the first layer.', & - units='m',default=0.) + units='m', default=0., scale=US%m_to_Z) call get_param(paramFile, mdl, 'MINIMUM_VT2', CS%minVtsqr, & 'Min of the unresolved velocity Vt2 used in Rib CVMix calculation.\n'// & 'Scaling: MINIMUM_VT2 = const1*d*N*ws, with d=1m, N=1e-5/s, ws=1e-6 m/s.', & - units='m2/s2',default=1e-10) - -! smg: for removal below - call get_param(paramFile, mdl, 'CORRECT_SURFACE_LAYER_AVERAGE', CS%correctSurfLayerAvg, & - 'If true, applies a correction step to the averaging of surface layer '// & - 'properties. This option is obsolete.', default=.False.) - if (CS%correctSurfLayerAvg) & - call MOM_error(FATAL,'Correct surface layer average disabled in code. To recover \n'// & - ' feature will require code intervention.') - call get_param(paramFile, mdl, 'FIRST_GUESS_SURFACE_LAYER_DEPTH', CS%surfLayerDepth, & - 'The first guess at the depth of the surface layer used for averaging '// & - 'the surface layer properties. If =0, the top model level properties '// & - 'will be used for the surface layer. If CORRECT_SURFACE_LAYER_AVERAGE=True, a '// & - 'subsequent correction is applied. This parameter is obsolete', units='m', default=0.) -! smg: for removal above + units='m2/s2', default=1e-10, scale=US%m_s_to_L_T**2) call get_param(paramFile, mdl, 'NLT_SHAPE', string, & 'MOM6 method to set nonlocal transport profile. '// & @@ -382,7 +365,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) call get_param(paramFile, mdl, 'CVMix_ZERO_H_WORK_AROUND', CS%min_thickness, & 'A minimum thickness used to avoid division by small numbers in the vicinity '// & 'of vanished layers. This is independent of MIN_THICKNESS used in other parts of MOM.', & - units='m', default=0.) + units='m', default=0., scale=US%m_to_Z) !/BGR: New options for including Langmuir effects !/ 1. Options related to enhancing the mixing coefficient @@ -430,9 +413,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) "Unrecognized KPP_LT_K_METHOD option: "//trim(string)) end select if (CS%LT_K_METHOD==LT_K_MODE_CONSTANT) then - call get_param(paramFile, mdl, "KPP_K_ENH_FAC",CS%KPP_K_ENH_FAC , & - 'Constant value to enhance mixing coefficient in KPP.', & - default=1.0) + call get_param(paramFile, mdl, "KPP_K_ENH_FAC", CS%KPP_K_ENH_FAC, & + 'Constant value to enhance mixing coefficient in KPP.', & + units="nondim", default=1.0) endif endif !/ 2. Options related to enhancing the unresolved Vt2/entrainment in Rib @@ -470,9 +453,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) "Unrecognized KPP_LT_VT2_METHOD option: "//trim(string)) end select if (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then - call get_param(paramFile, mdl, "KPP_VT2_ENH_FAC",CS%KPP_VT2_ENH_FAC , & + call get_param(paramFile, mdl, "KPP_VT2_ENH_FAC", CS%KPP_VT2_ENH_FAC, & 'Constant value to enhance VT2 in KPP.', & - default=1.0) + units="nondim", default=1.0) endif endif @@ -481,8 +464,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) call CVMix_init_kpp( Ri_crit=CS%Ri_crit, & - minOBLdepth=CS%minOBLdepth, & - minVtsqr=CS%minVtsqr, & + minOBLdepth=US%Z_to_m*CS%minOBLdepth, & + minVtsqr=US%L_T_to_m_s**2*CS%minVtsqr, & vonKarman=CS%vonKarman, & surf_layer_ext=CS%surf_layer_ext, & interp_type=CS%interpType, & @@ -547,13 +530,17 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & - 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C', conversion=US%C_to_degC) + 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'C', conversion=US%C_to_degC) CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & - 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'ppt', conversion=US%S_to_ppt) + 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'ppt', conversion=US%S_to_ppt) CS%id_Usurf = register_diag_field('ocean_model', 'KPP_Usurf', diag%axesCu1, Time, & - 'i-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') + 'i-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'm/s', conversion=US%L_T_to_m_s) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & - 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') + 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'm/s', conversion=US%L_T_to_m_s) CS%id_EnhK = register_diag_field('ocean_model', 'EnhK', diag%axesTI, Time, & 'Langmuir number enhancement to K as used by [CVMix] KPP','nondim') CS%id_EnhVt2 = register_diag_field('ocean_model', 'EnhVt2', diag%axesTL, Time, & @@ -616,7 +603,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier -! Local variables + ! Local variables integer :: i, j, k ! Loop indices real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) @@ -624,14 +611,16 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & real, dimension( GV%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces [m2 s-1] real, dimension( GV%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] - real :: surfFricVel, surfBuoyFlux - real :: sigma, sigmaRatio + real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] + real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] + real :: sigma ! Fractional vertical position within the boundary layer [nondim] + real :: sigmaRatio ! A cubic function of sigma [nondim] real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] - real :: dh ! The local thickness used for calculating interface positions [m] - real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] + real :: dh ! The local thickness used for calculating interface positions [Z ~> m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] ! For Langmuir Calculations - real :: LangEnhK ! Langmuir enhancement for mixing coefficient + real :: LangEnhK ! Langmuir enhancement for mixing coefficient [nondim] if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & "KPP_calculate: The Waves control structure must be associated if STOKES_MIXING is True.") @@ -672,17 +661,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo ! k-loop finishes surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! h to Monin-Obukov (default is false, ie. not used) + ! h to Monin-Obukhov (default is false, ie. not used) ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -820,8 +809,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! we apply nonLocalTrans in subroutines ! KPP_NonLocalTransport_temp and KPP_NonLocalTransport_saln - nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temp - nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln + nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temperature + nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! salinity ! set the KPP diffusivity and viscosity to zero for testing purposes if (CS%KPPzeroDiffusivity) then @@ -906,48 +895,54 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult!< Langmuir enhancement factor + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor ! Local variables - integer :: i, j, k, km1 ! Loop indices + ! Variables in MKS units for passing to CVMix routines real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] - real, dimension( GV%ke ) :: surfBuoyFlux2 + real, dimension( GV%ke ) :: surfBuoyFlux2 ! Surface buoyancy flux in MKS units [m2 s-3] real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] + real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] + real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] + real :: Coriolis ! Coriolis parameter at tracer points [s-1] + real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] - ! for EOS calculation + ! Variables for EOS calculations real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] real, dimension( 3*GV%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] real, dimension( 3*GV%ke ) :: Temp_1D ! A column of temperatures [C ~> degC] real, dimension( 3*GV%ke ) :: Salt_1D ! A column of salinities [S ~> ppt] - real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho ! Gravitational acceleration divided by density in MKS units [m R-1 s-2 ~> m4 kg-1 s-2] - real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] - real :: Uk, Vk - - real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] - real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. - real :: hTot ! Running sum of thickness used in the surface layer average [m] - real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] - real :: delH ! Thickness of a layer [m] - real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer [C ~> degC] - real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer [S ~> ppt] - real :: surfHu, surfU ! Integral and average of u over the surface layer - real :: surfHv, surfV ! Integral and average of v over the surface layer - real :: dh ! The local thickness used for calculating interface positions [m] - real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] - integer :: kk, ksfc, ktmp + real :: GoRho ! Gravitational acceleration in MKS units divided by density [m s-2 R-1 ~> m4 kg-1 s-2] + real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] + real :: Uk, Vk ! Layer velocities relative to their averages in the surface layer [L T-1 ~> m s-1] + real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth [Z ~> m] + real :: hTot ! Running sum of thickness used in the surface layer average [Z ~> m] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] + real :: delH ! Thickness of a layer [Z ~> m] + real :: surfTemp ! Average of temperature over the surface layer [C ~> degC] + real :: surfHtemp ! Integral of temperature over the surface layer [Z C ~> m degC] + real :: surfSalt ! Average of salinity over the surface layer [S ~> ppt] + real :: surfHsalt ! Integral of salinity over the surface layer [Z S ~> m ppt] + real :: surfHu, surfHv ! Integral of u and v over the surface layer [Z L T-1 ~> m2 s-1] + real :: surfU, surfV ! Average of u and v over the surface layer [Z T-1 ~> m s-1] + real :: dh ! The local thickness used for calculating interface positions [Z ~> m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] ! For Langmuir Calculations - real :: LangEnhVt2 ! Langmuir enhancement for unresolved shear - real, dimension(GV%ke) :: U_H, V_H - real :: MLD_GUESS, LA - real :: surfHuS, surfHvS, surfUs, surfVs + real :: LangEnhVt2 ! Langmuir enhancement for unresolved shear [nondim] + real, dimension(GV%ke) :: U_H, V_H ! Velocities at tracer points [L T-1 ~> m s-1] + real :: MLD_guess ! A guess at the mixed layer depth for calculating the Langmuir number [Z ~> m] + real :: LA ! The local Langmuir number [nondim] + real :: surfHuS, surfHvS ! Stokes drift velocities integrated over the boundary layer [Z L T-1 ~> m2 s-1] + real :: surfUs, surfVs ! Stokes drift velocities averaged over the boundary layer [Z T-1 ~> m s-1] + + integer :: i, j, k, km1, kk, ksfc, ktmp ! Loop indices if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & "KPP_compute_BLD: The Waves control structure must be associated if STOKES_MIXING is True.") @@ -971,7 +966,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !$OMP ksfc, surfHtemp, surfHsalt, surfHu, surfHv, surfHuS, & !$OMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, & !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, & - !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_GUESS, LA, rho_1D, & + !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_guess, LA, rho_1D, & !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2, & !$OMP BulkRi_1d, zBottomMinusOffset) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & @@ -983,8 +978,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (G%mask2dT(i,j)==0.) cycle do k=1,GV%ke - U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) + U_H(k) = 0.5 * (u(i,j,k)+u(i-1,j,k)) + V_H(k) = 0.5 * (v(i,j,k)+v(i,j-1,k)) enddo ! things independent of position within the column @@ -1004,36 +999,36 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh ! find ksfc for cell where "surface layer" sits - SLdepth_0d = CS%surf_layer_ext*max( max(-cellHeight(k),-iFaceHeight(2) ), CS%minOBLdepth ) + SLdepth_0d = CS%surf_layer_ext*max( US%m_to_Z*max(-cellHeight(k),-iFaceHeight(2) ), CS%minOBLdepth ) ksfc = k do ktmp = 1,k - if (-1.0*iFaceHeight(ktmp+1) >= SLdepth_0d) then + if (-1.0*iFaceHeight(ktmp+1) >= US%Z_to_m*SLdepth_0d) then ksfc = ktmp exit endif enddo - ! average temp, saln, u, v over surface layer - ! use C-grid average to get u,v on T-points. - surfHtemp=0.0 - surfHsalt=0.0 - surfHu =0.0 - surfHv =0.0 - surfHuS =0.0 - surfHvS =0.0 - hTot =0.0 + ! average temperature, salinity, u and v over surface layer + ! use C-grid average to get u and v on T-points. + surfHtemp = 0.0 + surfHsalt = 0.0 + surfHu = 0.0 + surfHv = 0.0 + surfHuS = 0.0 + surfHvS = 0.0 + hTot = 0.0 do ktmp = 1,ksfc ! SLdepth_0d can be between cell interfaces - delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_m ) + delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_Z ) ! surface layer thickness hTot = hTot + delH @@ -1041,11 +1036,11 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH - surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH - surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then - surfHus = surfHus + 0.5*US%L_T_to_m_s*(Waves%US_x(i,j,ktmp)+Waves%US_x(i-1,j,ktmp)) * delH - surfHvs = surfHvs + 0.5*US%L_T_to_m_s*(Waves%US_y(i,j,ktmp)+Waves%US_y(i,j-1,ktmp)) * delH + surfHus = surfHus + 0.5*(Waves%US_x(i,j,ktmp)+Waves%US_x(i-1,j,ktmp)) * delH + surfHvs = surfHvs + 0.5*(Waves%US_y(i,j,ktmp)+Waves%US_y(i,j-1,ktmp)) * delH endif enddo @@ -1056,23 +1051,22 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfUs = surfHus / hTot surfVs = surfHvs / hTot - ! vertical shear between present layer and - ! surface layer averaged surfU,surfV. + ! vertical shear between present layer and surface layer averaged surfU and surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then ! the Stokes drift must be included in the bulk Richardson number ! calculation. - Uk = Uk + (0.5*US%L_T_to_m_s*(Waves%Us_x(i,j,k)+Waves%US_x(i-1,j,k)) - surfUs ) - Vk = Vk + (0.5*US%L_T_to_m_s*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) - surfVs ) + Uk = Uk + (0.5*(Waves%Us_x(i,j,k)+Waves%US_x(i-1,j,k)) - surfUs ) + Vk = Vk + (0.5*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) - surfVs ) endif - deltaU2(k) = Uk**2 + Vk**2 + deltaU2(k) = US%L_T_to_m_s**2 * (Uk**2 + Vk**2) - ! pressure, temp, and saln for EOS + ! pressure, temperature, and salinity for calling the equation of state ! kk+1 = surface fields ! kk+2 = k fields ! kk+3 = km1 fields @@ -1098,7 +1092,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl enddo ! k-loop finishes if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then - MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) + MLD_guess = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j)=LA @@ -1127,12 +1121,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! computes w_s and w_m velocity scale at sigma=CS%surf_layer_ext. So we only pass ! sigma=CS%surf_layer_ext for this calculation. call CVMix_kpp_compute_turbulent_scales( & - CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext - -cellHeight, & ! (in) Assume here that OBL depth [m] = -cellHeight(k) - surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] - surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] - CVMix_kpp_params_user=CS%KPP_params ) + CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext + -cellHeight, & ! (in) Assume here that OBL depth [m] = -cellHeight(k) + surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] + surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] + CVMix_kpp_params_user=CS%KPP_params ) ! Determine the enhancement factor for unresolved shear IF (CS%LT_VT2_ENHANCEMENT) then @@ -1172,25 +1166,25 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces [m] - CS%OBLdepth(i,j), & ! (out) OBL depth [m] - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers [m] - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] - Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces [m] + CS%OBLdepth(i,j), & ! (out) OBL depth [m] + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers [m] + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] + Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters ! A hack to avoid KPP reaching the bottom. It was needed during development ! because KPP was unable to handle vanishingly small layers near the bottom. if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(GV%ke+1)) + zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(US%Z_to_m*CS%deepOBLoffset, -0.1*iFaceHeight(GV%ke+1)) CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif ! apply some constraints on OBLdepth - if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = US%Z_to_m*CS%fixedOBLdepth_value CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) @@ -1211,14 +1205,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! recompute wscale for diagnostics, now that we in fact know boundary layer depth !BGR consider if LTEnhancement is wanted for diagnostics if (CS%id_Ws > 0) then - call CVMix_kpp_compute_turbulent_scales( & + call CVMix_kpp_compute_turbulent_scales( & -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate CS%OBLdepth(i,j), & ! (in) OBL depth [m] surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters - CS%Ws(i,j,:) = Ws_1d(:) + CS%Ws(i,j,:) = Ws_1d(:) endif ! Diagnostics @@ -1229,7 +1223,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV enddo enddo @@ -1252,17 +1246,18 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) ! BLD smoothing: - if (CS%n_smooth > 0) call KPP_smooth_BLD(CS,G,GV,h) + if (CS%n_smooth > 0) call KPP_smooth_BLD(CS, G, GV, US, h) end subroutine KPP_compute_BLD !> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise -subroutine KPP_smooth_BLD(CS,G,GV,h) +subroutine KPP_smooth_BLD(CS, G, GV, US, h) ! Arguments type(KPP_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local @@ -1272,8 +1267,8 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] ! (negative in the ocean) real :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] - real :: dh ! The local thickness used for calculating interface positions [m] - real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] + real :: dh ! The local thickness used for calculating interface positions [Z ~> m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] integer :: i, j, k, s call cpu_clock_begin(id_clock_KPP_smoothing) @@ -1288,7 +1283,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) OBLdepth_prev = CS%OBLdepth ! apply smoothing on OBL depth - !$OMP parallel do default(none) shared(G, GV, CS, h, OBLdepth_prev) & + !$OMP parallel do default(none) shared(G, GV, US, CS, h, OBLdepth_prev) & !$OMP private(wc, ww, we, wn, ws, dh, hcorr, cellHeight, iFaceHeight) do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1301,12 +1296,12 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo ! compute weights @@ -1347,9 +1342,9 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD !< Boundary layer depth [Z ~> m] or other units real, optional, intent(in) :: m_to_BLD_units !< A conversion factor from meters - !! to the desired units for BLD + !! to the desired units for BLD [various] ! Local variables - real :: scale ! A dimensional rescaling factor + real :: scale ! A dimensional rescaling factor in [Z m-1 ~> 1] or other units. integer :: i,j scale = US%m_to_Z ; if (present(m_to_BLD_units)) scale = m_to_BLD_units @@ -1376,11 +1371,12 @@ subroutine KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, & type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) real, optional, intent(in) :: flux_scale !< Scale factor to get surfFlux - !! into proper units + !! into proper units [various] integer :: i, j, k real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dtracer ! Rate of tracer change [conc T-1 ~> conc s-1] - real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc + real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc ! An optionally rescaled surface flux of the scalar + ! in [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] or other units ! term used to scale if (present(flux_scale)) then diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 58d6e3417a..a0b24dee70 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -27,14 +27,14 @@ module MOM_CVMix_conv type, public :: CVMix_conv_cs ; private ! Parameters - real :: kd_conv_const !< diffusivity constant used in convective regime [m2 s-1] - real :: kv_conv_const !< viscosity constant used in convective regime [m2 s-1] + real :: kd_conv_const !< diffusivity constant used in convective regime [Z2 T-1 ~> m2 s-1] + real :: kv_conv_const !< viscosity constant used in convective regime [Z2 T-1 ~> m2 s-1] real :: bv_sqr_conv !< Threshold for squared buoyancy frequency - !! needed to trigger Brunt-Vaisala parameterization [s-2] - real :: min_thickness !< Minimum thickness allowed [m] + !! needed to trigger Brunt-Vaisala parameterization [T-2 ~> s-2] + real :: min_thickness !< Minimum thickness allowed [Z ~> m] logical :: debug !< If true, turn on debugging - ! Daignostic handles and pointers + ! Diagnostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure !>@{ Diagnostics handles integer :: id_N2 = -1, id_kd_conv = -1, id_kv_conv = -1 @@ -55,13 +55,13 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convetction control struct + type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convection control structure real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. logical :: useEPBL !< If True, use the ePBL boundary layer scheme. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" ! Read parameters call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, default=.false., do_not_log=.true.) @@ -90,7 +90,8 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & + units="m", scale=US%m_to_Z, default=0.001, do_not_log=.True.) call openParameterBlock(param_file,'CVMix_CONVECTION') @@ -102,12 +103,12 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & "Diffusivity used in convective regime. Corresponding viscosity "//& "(KV_CONV) will be set to KD_CONV * PRANDTL_CONV.", & - units='m2/s', default=1.00) + units='m2/s', default=1.00, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & "Threshold for squared buoyancy frequency needed to trigger "//& "Brunt-Vaisala parameterization.", & - units='1/s^2', default=0.0) + units='1/s^2', default=0.0, scale=US%T_to_s**2) call closeParameterBlock(param_file) @@ -123,10 +124,10 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) - call CVMix_init_conv(convect_diff=CS%kd_conv_const, & - convect_visc=CS%kv_conv_const, & + call CVMix_init_conv(convect_diff=US%Z2_T_to_m2_s*CS%kd_conv_const, & + convect_visc=US%Z2_T_to_m2_s*CS%kv_conv_const, & lBruntVaisala=.true., & - BVsqr_convect=CS%bv_sqr_conv) + BVsqr_convect=US%s_to_T**2*CS%bv_sqr_conv) end function CVMix_conv_init @@ -139,7 +140,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control struct + type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: Kd !< Diapycnal diffusivity at each interface that @@ -167,14 +168,14 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) kd_conv, & !< Diffusivity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] kv_conv, & !< Viscosity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] N2_3d !< Squared buoyancy frequency for diagnostics [T-2 ~> s-2] - integer :: kOBL !< level of OBL extent - real :: g_o_rho0 ! Gravitational acceleration divided by density times unit convserion factors + integer :: kOBL !< level of ocean boundary layer extent + real :: g_o_rho0 ! Gravitational acceleration divided by density times unit conversion factors ! [Z s-2 R-1 ~> m4 s-2 kg-1] real :: pref ! Interface pressures [R L2 T-2 ~> Pa] real :: rhok, rhokm1 ! In situ densities of the layers above and below at the interface pressure [R ~> kg m-3] real :: hbl_KPP ! The depth of the ocean boundary as used by KPP [m] real :: dz ! A thickness [Z ~> m] - real :: dh, hcorr ! Two thicknesses [m] + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] integer :: i, j, k g_o_rho0 = US%L_to_Z**2*US%s_to_T**2 * GV%g_Earth / GV%Rho0 @@ -213,12 +214,12 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) hcorr = 0.0 ! compute heights at cell center and interfaces do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, in the units used by CVMix. + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo ! gets index of the level and interface above hbl diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 413b87f631..6e2c76ba8d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -28,14 +28,14 @@ module MOM_CVMix_ddiff ! Parameters real :: strat_param_max !< maximum value for the stratification parameter [nondim] real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime - !! for salinity diffusion [m2 s-1] + !! for salinity diffusion [Z2 T-1 ~> m2 s-1] real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula [nondim] real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula [nondim] - real :: mol_diff !< molecular diffusivity [m2 s-1] + real :: mol_diff !< molecular diffusivity [Z2 T-1 ~> m2 s-1] real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime [nondim] real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime [nondim] real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime [nondim] - real :: min_thickness !< Minimum thickness allowed [m] + real :: min_thickness !< Minimum thickness allowed [Z ~> m] character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") logical :: debug !< If true, turn on debugging @@ -57,8 +57,8 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" if (associated(CS)) then call MOM_error(WARNING, "CVMix_ddiff_init called with an associated "// & @@ -82,7 +82,8 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & + units="m", scale=US%m_to_Z, default=0.001, do_not_log=.True.) call openParameterBlock(param_file,'CVMIX_DDIFF') @@ -91,8 +92,8 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=2.55) call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & - "Leading coefficient in formula for salt-fingering regime "//& - "for salinity diffusion.", units="m2 s-1", default=1.0e-4) + "Leading coefficient in formula for salt-fingering regime for salinity diffusion.", & + units="m2 s-1", default=1.0e-4, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & "Interior exponent in salt-fingering regime formula.", & @@ -116,7 +117,7 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MOL_DIFF", CS%mol_diff, & "Molecular diffusivity used in CVMix double diffusion.", & - units="m2 s-1", default=1.5e-6) + units="m2 s-1", default=1.5e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DIFF_CONV_TYPE", CS%diff_conv_type, & "type of diffusive convection to use. Options are Marmorino \n" //& @@ -126,10 +127,10 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call closeParameterBlock(param_file) call cvmix_init_ddiff(strat_param_max=CS%strat_param_max, & - kappa_ddiff_s=CS%kappa_ddiff_s, & + kappa_ddiff_s=US%Z2_T_to_m2_s*CS%kappa_ddiff_s, & ddiff_exp1=CS%ddiff_exp1, & ddiff_exp2=CS%ddiff_exp2, & - mol_diff=CS%mol_diff, & + mol_diff=US%Z2_T_to_m2_s*CS%mol_diff, & kappa_ddiff_param1=CS%kappa_ddiff_param1, & kappa_ddiff_param2=CS%kappa_ddiff_param2, & kappa_ddiff_param3=CS%kappa_ddiff_param3, & @@ -160,21 +161,21 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! Local variables real, dimension(SZK_(GV)) :: & cellHeight, & !< Height of cell centers [m] - dRho_dT, & !< partial derivatives of density wrt temp [R C-1 ~> kg m-3 degC-1] - dRho_dS, & !< partial derivatives of density wrt saln [R S-1 ~> kg m-3 ppt-1] + dRho_dT, & !< partial derivatives of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & !< partial derivatives of density with salinity [R S-1 ~> kg m-3 ppt-1] pres_int, & !< pressure at each interface [R L2 T-2 ~> Pa] temp_int, & !< temp and at interfaces [C ~> degC] salt_int, & !< salt at at interfaces [S ~> ppt] alpha_dT, & !< alpha*dT across interfaces [kg m-3] beta_dS, & !< beta*dS across interfaces [kg m-3] - dT, & !< temp. difference between adjacent layers [C ~> degC] - dS !< salt difference between adjacent layers [S ~> ppt] + dT, & !< temperature difference between adjacent layers [C ~> degC] + dS !< salinity difference between adjacent layers [S ~> ppt] real, dimension(SZK_(GV)+1) :: & Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1]. Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1]. real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [m] - real :: dh, hcorr + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] integer :: i, k ! initialize dummy variables @@ -184,7 +185,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! GMM, I am leaving some code commented below. We need to pass BLD to - ! this soubroutine to avoid adding diffusivity above that. This needs + ! this subroutine to avoid adding diffusivity above that. This needs ! to be done once we re-structure the order of the calls. !if (.not. associated(hbl)) then ! allocate(hbl(SZI_(G), SZJ_(G))); @@ -234,16 +235,16 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) hcorr = 0.0 ! compute heights at cell center and interfaces do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in height units dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo ! gets index of the level and interface above hbl - !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j)) Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & @@ -277,7 +278,7 @@ logical function CVMix_ddiff_is_used(param_file) end function CVMix_ddiff_is_used -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory ! NOTE: Placeholder destructor subroutine CVMix_ddiff_end(CS) type(CVMix_ddiff_cs), pointer :: CS !< Control structure for this module that diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 7ec45dbe11..b69cd2daae 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -28,19 +28,19 @@ module MOM_CVMix_shear ! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure including parameters for CVMix interior shear schemes. -type, public :: CVMix_shear_cs ! TODO: private +type, public :: CVMix_shear_cs ; private logical :: use_LMD94 !< Flags to use the LMD94 scheme logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981) logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter - real :: Ri_zero !< LMD94 critical Richardson number - real :: Nu_zero !< LMD94 maximum interior diffusivity - real :: KPP_exp !< Exponent of unitless factor of diff. - !! for KPP internal shear mixing scheme. + real :: Ri_zero !< LMD94 critical Richardson number [nondim] + real :: Nu_zero !< LMD94 maximum interior diffusivity [Z2 T-1 ~> m2 s-1] + real :: KPP_exp !< Exponent of unitless factor of diffusivities + !! for KPP internal shear mixing scheme [nondim] real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency [T-2 ~> s-2] - real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number + real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number [nondim] real, allocatable, dimension(:,:,:) :: ri_grad_smooth !< Gradient Richardson number - !! after smoothing + !! after smoothing [nondim] character(10) :: Mix_Scheme !< Mixing scheme name (string) type(diag_ctrl), pointer :: diag => NULL() !< Pointer to the diagnostics control structure @@ -137,7 +137,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) S2 = US%L_to_Z**2*(DU*DU+DV*DV)/(DZ*DZ) Ri_Grad(k) = max(0., N2) / max(S2, 1.e-10*US%T_to_s**2) - ! fill 3d arrays, if user asks for diagsnostics + ! fill 3d arrays, if user asks for diagnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 @@ -264,22 +264,22 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "NU_ZERO", CS%Nu_Zero, & "Leading coefficient in KPP shear mixing.", & - units="nondim", default=5.e-3) + units="m2 s-1", default=5.e-3, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "RI_ZERO", CS%Ri_Zero, & "Critical Richardson for KPP shear mixing, "// & "NOTE this the internal mixing and this is "// & - "not for setting the boundary layer depth." & - ,units="nondim", default=0.8) + "not for setting the boundary layer depth.", & + units="nondim", default=0.8) call get_param(param_file, mdl, "KPP_EXP", CS%KPP_exp, & "Exponent of unitless factor of diffusivities, "// & - "for KPP internal shear mixing scheme." & - ,units="nondim", default=3.0) + "for KPP internal shear mixing scheme.", & + units="nondim", default=3.0) call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & "If true, vertically smooth the Richardson "// & "number by applying a 1-2-1 filter once.", & default = .false.) call cvmix_init_shear(mix_scheme=CS%Mix_Scheme, & - KPP_nu_zero=CS%Nu_Zero, & + KPP_nu_zero=US%Z2_T_to_m2_s*CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & KPP_exp=CS%KPP_exp) @@ -332,7 +332,7 @@ logical function CVMix_shear_is_used(param_file) CVMix_shear_is_used = (LMD94 .or. PP81) end function CVMix_shear_is_used -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory subroutine CVMix_shear_end(CS) type(CVMix_shear_cs), intent(inout) :: CS !< Control structure for this module that !! will be deallocated in this subroutine diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 75798ed466..fa3dbe4b87 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -62,7 +62,7 @@ module MOM_tidal_mixing real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2] real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m] real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal dissipation with Polzin [Z ~> m] - real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient + real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient [nondim] end type !> Control structure with parameters for the tidal mixing module. @@ -129,13 +129,14 @@ module MOM_tidal_mixing logical :: use_CVMix_tidal = .false. !< true if CVMix is to be used for determining !! diffusivity due to tidal mixing - real :: min_thickness !< Minimum thickness allowed [m] + real :: min_thickness !< Minimum thickness allowed [Z ~> m] ! CVMix-specific parameters integer :: CVMix_tidal_scheme = -1 !< 1 for Simmons, 2 for Schmittner type(CVMix_tidal_params_type) :: CVMix_tidal_params !< A CVMix-specific type with parameters for tidal mixing type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only - real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s] + real :: tidal_max_coef !< CVMix-specific maximum allowable tidal + !! diffusivity. [Z2 T-1 ~> m2 s-1] real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for !! tidal-energy-constituent data [Z ~> m]. type(remapping_CS) :: remap_CS !< The control structure for remapping @@ -443,8 +444,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & "The decay scale away from the bottom for tidal TKE with "//& "the new coding when INT_TIDE_DISSIPATION is used.", & - !units="m", default=0.0) - units="m", default=500.0, scale=US%m_to_Z) ! TODO: confirm this new default + units="m", default=500.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with "//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -564,12 +564,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & "The fraction of the lee wave energy that is dissipated "//& - "locally with LEE_WAVE_DISSIPATION.", units="nondim", & - default=0.3333) + "locally with LEE_WAVE_DISSIPATION.", units="nondim", default=0.3333) call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & "Scaling for the vertical decay scale of the local "//& - "dissipation of lee wave dissipation.", units="nondim", & - default=1.0) + "dissipation of lee wave dissipation.", units="nondim", default=1.0) else CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False endif @@ -581,18 +579,17 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di !call openParameterBlock(param_file,'CVMix_TIDAL') call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & - units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMix, 100e-4 in POP. + units="m^2/s", default=50e-4, scale=US%m2_s_to_Z2_T) ! the default is 50e-4 in CVMix, 100e-4 in POP. call get_param(param_file, mdl, "TIDAL_DISS_LIM_TC", CS%tidal_diss_lim_tc, & "Min allowable depth for dissipation for tidal-energy-constituent data. "//& "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & units="m", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & - do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & + units="m", default=0.001, scale=US%m_to_Z, do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & "Prandtl number used by CVMix tidal mixing schemes "//& "to convert vertical diffusivities into viscosities.", & - units="nondim", default=1.0, & - do_not_log=.true.) + units="nondim", default=1.0, do_not_log=.true.) call CVMix_put(CS%CVMix_glb_params,'Prandtl',prandtl_tidal) call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & @@ -615,7 +612,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di mix_scheme = CVMix_tidal_scheme_str, & efficiency = CS%Mu_itides, & vertical_decay_scale = CS%int_tide_decay_scale*US%Z_to_m, & - max_coefficient = CS%tidal_max_coef, & + max_coefficient = CS%tidal_max_coef*US%Z2_T_to_m2_s, & local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides*US%Z_to_m) @@ -777,19 +774,21 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! Local variables real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] - real, dimension(SZK_(GV)+1) :: vert_dep ! vertical deposition + real, dimension(SZK_(GV)+1) :: vert_dep ! vertical deposition [nondim] real, dimension(SZK_(GV)+1) :: iFaceHeight ! Height of interfaces [m] real, dimension(SZK_(GV)+1) :: SchmittnerSocn real, dimension(SZK_(GV)) :: cellHeight ! Height of cell centers [m] real, dimension(SZK_(GV)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input ! to model coordinates real, dimension(SZK_(GV)+1) :: N2_int_i ! De-scaled interface buoyancy frequency [s-2] - real, dimension(SZK_(GV)) :: Schmittner_coeff + real, dimension(SZK_(GV)) :: Schmittner_coeff ! A coefficient in the Schmittner et al (2014) mixing + ! parameterization [nondim] real, dimension(SZK_(GV)) :: h_m ! Cell thickness [m] real, allocatable, dimension(:,:) :: exp_hab_zetar + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] + real :: Simmons_coeff ! A coefficient in the Simmons et al (2004) mixing parameterization [nondim] integer :: i, k, is, ie - real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg m-3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) @@ -803,14 +802,14 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 + ! Compute cell center depth and cell bottom in meters (negative values in the ocean) do k=1,GV%ke - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix. + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo call CVMix_compute_Simmons_invariant( nlev = GV%ke, & @@ -889,16 +888,17 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int if (G%mask2dT(i,j)<1) cycle - iFaceHeight = 0.0 ! BBL is all relative to the surface + iFaceHeight(:) = 0.0 ! BBL is all relative to the surface hcorr = 0.0 + ! Compute heights at cell center and interfaces, and rescale layer thicknesses do k=1,GV%ke h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0) + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo SchmittnerSocn = 0.0 ! TODO: compute this From 5ef380c0909d7553bc81658a8ba3c9f6122a5acf Mon Sep 17 00:00:00 2001 From: "Andrew C. Ross" Date: Wed, 16 Nov 2022 10:50:29 -0500 Subject: [PATCH 056/213] Only add runoff tracer flux to surface flux if it has not already been added --- config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 | 1 + src/tracer/MOM_generic_tracer.F90 | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 index e0d3b1d6a9..ea9f225a27 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -28,6 +28,7 @@ module g_tracer_utils character(len=fm_string_len) :: obc_src_file_name !< Boundary condition tracer source filename character(len=fm_string_len) :: obc_src_field_name !< Boundary condition tracer source fieldname integer :: src_var_record !< Unknown + logical :: runoff_added_to_stf = .false. !< Has flux in from runoff been added to stf? logical :: requires_src_info = .false. !< Unknown real :: src_var_unit_conversion = 1.0 !< This factor depends on the tracer. Ask Jasmin real :: src_var_valid_min = 0.0 !< Unknown diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4e88944958..131110e6b2 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -512,7 +512,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (_ALLOCATED(g_tracer%trunoff)) then + if (_ALLOCATED(g_tracer%trunoff) .and. (.NOT. g_tracer%runoff_added_to_stf)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) @@ -521,6 +521,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * & US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) stf_array = stf_array + runoff_tracer_flux_array + g_tracer%runoff_added_to_stf = .true. endif !traverse the linked list till hit NULL From 717343243f8e4fc80362a422fb71e63d331839c1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Dec 2022 03:10:30 -0500 Subject: [PATCH 057/213] *Fix new scaling bug in ML restrat minimum ustar There are extra US%T_to_s scaling factors in the expressions for ustar_min that were recently introduced with dev/gfdl PR #251; these are duplicative of the scaling factor that is already being applied when the parameter OMEGA is read in. The resulting expressions for ustar_min therefore effectively have units of [Z s T-2 ~> m s-1] when they should have units of [Z T-1 ~> m s-1]. Because ustar_min is a tiny floor on the magnitude of ustar, there is a range of values of T_RESCALE_POWER that will give the same answers as when it is 0, but for large enough values the answers will change, perhaps dramatically. This small commit removes these extra factors. Answers will change for some large values of T_RESCALE_POWER, but they are bitwise identical in the TC testing and in MOM6-examples based regression tests with modest or negative values. --- .../lateral/MOM_mixed_layer_restrat.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 506046340d..102e2723aa 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -309,7 +309,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z - ustar_min = 2e-4 * CS%omega * US%T_to_S * (GV%Angstrom_Z + dz_neglect) + ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + dz_neglect) if (CS%front_length>0.) then res_upscale = .true. I_LFront = 1. / CS%front_length @@ -666,7 +666,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z - ustar_min = 2e-4 * CS%omega * US%T_to_S * (GV%Angstrom_Z + dz_neglect) + ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + dz_neglect) if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -932,9 +932,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, units="nondim", default=1.0) endif call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) - + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) CS%diag => diag From 8de33f906ffc34ec5dc47e63412ad4f67decc768 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Dec 2022 12:16:14 -0500 Subject: [PATCH 058/213] +Add runtime params KV_RESTRAT & RESTRAT_USTAR_MIN Added the runtime parameters KV_RESTRAT and RESTRAT_USTAR_MIN, to build on the improvements in github.com/NOAA-GFDL/MOM6/pull/251, and to provide run-time physical parameters to avoid the potential division by zero in the mixed_layer_restrat code noted at github.com/mom-ocean/MOM6/issues/1168. Once this PR is merged onto the main branch of MOM6, that issue can be closed. By default, these do not change answers in the MOM6-examples test suite, but the default value for RESTRAT_USTAR_MIN was taken from the hard-coded value in PR that PR. The six copies of the eddy growth rate timescale calculations were consolidated into a new internal function, growth_time, with some other related minor refactoring of the code. Also, mixedlayer_restrat_register_restarts now takes a unit_scale_type arguments like many other analogous routines. All answers are bitwise identical, but there are new runtime parameters or comments that lead to changes in the MOM_parameter_doc files. Also clarified in the comments sent to the MOM_parameter_doc files how VISBECK_L_SCALE works as a dimensional scaling factor when it is given a negative value, and rescaled its units when read as though it were always in m. --- src/core/MOM.F90 | 16 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 20 +- .../lateral/MOM_mixed_layer_restrat.F90 | 201 ++++++++++-------- 3 files changed, 126 insertions(+), 111 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 6c978b36f5..d1fd8619da 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2219,11 +2219,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "A tiny magnitude of temperatures below which they are set to 0.", & units="degC", default=0.0, scale=US%degC_to_C) call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & - "The heat capacity of sea water, approximated as a "//& - "constant. This is only used if ENABLE_THERMODYNAMICS is "//& - "true. The default value is from the TEOS-10 definition "//& - "of conservative temperature.", units="J kg-1 K-1", & - default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC) + "The heat capacity of sea water, approximated as a constant. "//& + "This is only used if ENABLE_THERMODYNAMICS is true. The default "//& + "value is from the TEOS-10 definition of conservative temperature.", & + units="J kg-1 K-1", default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC) call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", CS%use_p_surf_in_EOS, & "If true, always include the surface pressure contributions "//& "in equation of state calculations.", default=.true.) @@ -2239,9 +2238,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The number of sublayers within the mixed layer if "//& "BULKMIXEDLAYER is true.", units="nondim", default=2) call get_param(param_file, "MOM", "NKBL", nkbl, & - "The number of layers that are used as variable density "//& - "buffer layers if BULKMIXEDLAYER is true.", units="nondim", & - default=2) + "The number of layers that are used as variable density buffer "//& + "layers if BULKMIXEDLAYER is true.", units="nondim", default=2) endif call get_param(param_file, "MOM", "GLOBAL_INDEXING", global_indexing, & @@ -2642,7 +2640,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MEKE_alloc_register_restart(HI, US, param_file, CS%MEKE, restart_CSp) call set_visc_register_restarts(HI, GV, US, param_file, CS%visc, restart_CSp) - call mixedlayer_restrat_register_restarts(HI, GV, param_file, & + call mixedlayer_restrat_register_restarts(HI, GV, US, param_file, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%rotate_index .and. associated(OBC_in) .and. use_temperature) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index aa561793e0..a8928ef06c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1177,12 +1177,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) default=.false.) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", KhTh_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& - "for the interface depth diffusivity", units="nondim", & - default=0.0) + "for the interface depth diffusivity", units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", KhTr_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& - "for the epipycnal tracer diffusivity", units="nondim", & - default=0.0) + "for the epipycnal tracer diffusivity", units="nondim", default=0.0) call get_param(param_file, mdl, "USE_STORED_SLOPES", CS%use_stored_slopes,& "If true, the isopycnal slopes are calculated once and "//& "stored for re-use. This uses more memory but avoids calling "//& @@ -1277,20 +1275,22 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) then in_use = .true. call get_param(param_file, mdl, "VISBECK_L_SCALE", CS%Visbeck_L_scale, & - "The fixed length scale in the Visbeck formula.", units="m", & - default=0.0) + "The fixed length scale in the Visbeck formula, or if negative a nondimensional "//& + "scaling factor relating this length scale squared to the cell areas.", & + units="m or nondim", default=0.0, scale=US%m_to_L) allocate(CS%L2u(IsdB:IedB,jsd:jed), source=0.0) allocate(CS%L2v(isd:ied,JsdB:JedB), source=0.0) if (CS%Visbeck_L_scale<0) then + ! Undo the rescaling of CS%Visbeck_L_scale. do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) + CS%L2u(I,j) = (US%L_to_m*CS%Visbeck_L_scale)**2 * G%areaCu(I,j) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) + CS%L2v(i,J) = (US%L_to_m*CS%Visbeck_L_scale)**2 * G%areaCv(i,J) enddo ; enddo else - CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 - CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 + CS%L2u(:,:) = CS%Visbeck_L_scale**2 + CS%L2v(:,:) = CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 102e2723aa..08c29c6c9e 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -48,7 +48,7 @@ module MOM_mixed_layer_restrat logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [R ~> kg m-3]. @@ -61,7 +61,9 @@ module MOM_mixed_layer_restrat type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance - real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1] + real :: Kv_restrat !< A viscosity that sets a floor on the momentum mixing rate + !! during restratification [Z2 T-1 ~> m2 s-1] real, dimension(:,:), allocatable :: & MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] @@ -103,8 +105,8 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the - !! PBL scheme [Z ~> m] - type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct + !! planetary boundary layer scheme [Z ~> m] + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & @@ -134,11 +136,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] (not H) - type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! Restratifying zonal thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! Restratifying meridional thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -156,12 +159,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] - real :: ustar_min ! A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux @@ -169,21 +170,22 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! layer [nondim]. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: b(SZK_(GV)) ! As for a(k) but for the slow-filtered MLD [nondim] - real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays - ! for diagnostic purposes. + real :: uDml(SZIB_(G)) ! Zonal volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml(SZI_(G)) ! Meridional volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: uDml_slow(SZIB_(G)) ! Zonal volume fluxes in the upper half of the boundary layer to + ! restratify the time-filtered boundary layer depth [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml_slow(SZI_(G)) ! Meridional volume fluxes in the upper half of the boundary layer to + ! restratify the time-filtered boundary layer depth [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! Zonal restratification timescale [T ~> s], stored for diagnostics. + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! Meridional restratification timescale [T ~> s], stored for diagnostics. real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities [R ~> kg m-3] + real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities and density differences [R ~> kg m-3] real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer ! densities [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G)) :: covTS, & !SGS TS covariance in Stanley param; currently 0 [degC ppt] - varS !SGS S variance in Stanley param; currently 0 [ppt2] + real, dimension(SZI_(G)) :: covTS, & ! SGS TS covariance in Stanley param; currently 0 [C S ~> degC ppt] + varS ! SGS S variance in Stanley param; currently 0 [S2 ~> ppt2] real :: aFac, bFac ! Nondimensional ratios [nondim] real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] @@ -191,9 +193,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: zpb ! Fractional position within the mixed layer of the interface below a layer [nondim] real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] - real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] - real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times - ! pi squared [nondim] + real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: line_is_empty, keep_going, res_upscale integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -202,10 +202,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers. - covTS(:)=0.0 !!Functionality not implemented yet; in future, should be passed in tv - varS(:)=0.0 - - vonKar_x_pi2 = CS%vonKar * 9.8696 + covTS(:) = 0.0 !!Functionality not implemented yet; in future, should be passed in tv + varS(:) = 0.0 if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -309,7 +307,6 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z - ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + dz_neglect) if (CS%front_length>0.) then res_upscale = .true. I_LFront = 1. / CS%front_length @@ -319,7 +316,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var p0(:) = 0.0 EOSdom(:) = EOS_domain(G%HI, halo=1) - !$OMP parallel default(shared) private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & + !$OMP parallel default(shared) private(rho_ml,h_vel,u_star,absf,timescale, & !$OMP line_is_empty, keep_going,res_scaling_fac, & !$OMP a,IhTot,b,Ihtot_slow,zpb,hAtVel,zpa,dh) & !$OMP firstprivate(uDml,vDml,uDml_slow,vDml_slow) @@ -381,29 +378,22 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) - ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) - ! momentum mixing rate: pi^2*visc/h_ml^2 h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z - mom_mixrate = vonKar_x_pi2*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - timescale = timescale * CS%ml_restrat_coef + timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z - mom_mixrate = vonKar_x_pi2*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - timescale = timescale * CS%ml_restrat_coef2 + timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -456,29 +446,22 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) - ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) - ! momentum mixing rate: pi^2*visc/h_ml^2 h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z - mom_mixrate = vonKar_x_pi2*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - timescale = timescale * CS%ml_restrat_coef + timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z - mom_mixrate = vonKar_x_pi2*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - timescale = timescale * CS%ml_restrat_coef2 + timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -575,10 +558,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call diag_update_remap_grids(CS%diag) contains - !> Stream function as a function of non-dimensional position within mixed-layer + !> Stream function [nondim] as a function of non-dimensional position within mixed-layer real function psi(z) real, intent(in) :: z !< Fractional mixed layer depth [nondim] - real :: psi1, bottop, xp, dd + real :: psi1 ! The streamfunction structure without the tail [nondim] + real :: bottop, xp, dd ! Local work variables used to generate the streamfunction tail [nondim] !psi1 = max(0., (1. - (2.*z + 1.)**2)) psi1 = max(0., (1. - (2.*z + 1.)**2) * (1. + (5./21.)*(2.*z + 1.)**2)) @@ -607,9 +591,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! Restratifying zonal thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! Restratifying meridional thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -623,14 +608,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. - real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times - ! pi squared [nondim] - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] - real :: ustar_min ! A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] @@ -638,11 +619,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux magnitudes (uDml & vDml) ! to the realized flux in a layer [nondim]. The vertical sum of a() ! through the pieces of the mixed layer must be 0. - real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D - ! arrays for diagnostic purposes. + real :: uDml(SZIB_(G)) ! Zonal volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml(SZI_(G)) ! Meridional volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! Zonal restratification timescale [T ~> s], stored for diagnostics. + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! Meridional restratification timescale [T ~> s], stored for diagnostics. real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -662,11 +642,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 - vonKar_x_pi2 = CS%vonKar * 9.8696 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z - ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + dz_neglect) if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -679,7 +657,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) p0(:) = 0.0 EOSdom(:) = EOS_domain(G%HI, halo=1) - !$OMP parallel default(shared) private(Rho0,h_vel,u_star,absf,mom_mixrate,timescale, & + !$OMP parallel default(shared) private(Rho0,h_vel,u_star,absf,timescale, & !$OMP I2htot,z_topx2,hx2,a) & !$OMP firstprivate(uDml,vDml) !$OMP do @@ -710,15 +688,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je ; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) - ! momentum mixing rate: pi^2*visc/h_ml^2 - mom_mixrate = vonKar_x_pi2*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - - timescale = timescale * CS%ml_restrat_coef + timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & @@ -756,15 +728,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = max(ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) - ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) - ! momentum mixing rate: pi^2*visc/h_ml^2 - mom_mixrate = vonKar_x_pi2*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - - timescale = timescale * CS%ml_restrat_coef + timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & @@ -833,6 +799,43 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) end subroutine mixedlayer_restrat_BML +!> Return the growth timescale for the submesoscale mixed layer eddies in [T ~> s] +real function growth_time(u_star, hBL, absf, h_neg, vonKar, Kv_rest, restrat_coef) + real, intent(in) :: u_star !< Surface friction velocity [Z T-1 ~> m s-1] + real, intent(in) :: hBL !< Boundary layer thickness including at least a neglible + !! value to keep it positive definite [Z ~> m] + real, intent(in) :: absf !< Absolute value of the Coriolis parameter [T-1 ~> s-1] + real, intent(in) :: h_neg !< A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] + real, intent(in) :: Kv_rest !< The background laminar vertical viscosity used for restratification [Z2 T-1 ~> m2 s-1] + real, intent(in) :: vonKar !< The von Karman constant, used to scale the turbulent limits + !! on the restratification timescales [nondim] + real, intent(in) :: restrat_coef !< An overall scaling factor for the restratification timescale [nondim] + + ! Local variables + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: Kv_eff ! An effective overall viscosity [Z1 T-1 ~> m2 s-1] + real :: pi2 ! A scaling constant that is approximately pi^2 [nondim] + + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + Kv_water + ! momentum mixing rate: pi^2*visc/h_ml^2 + pi2 = 9.8696 ! Approximately pi^2. This is more accurate than the overall uncertainty of the + ! scheme, with a value that is chosen to reproduce previous answers. + if (Kv_rest <= 0.0) then + ! This case reproduces the previous answers, but the extra h_neg is otherwise unnecessary. + mom_mixrate = (pi2*vonKar)*u_star**2 / (absf*hBL**2 + 4.0*(hBL + h_neg)*u_star) + growth_time = restrat_coef * (0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)) + else + ! Set the mixing rate to the sum of a turbulent mixing rate and a laminar viscous rate. + ! mom_mixrate = pi2*vonKar*u_star**2 / (absf*hBL**2 + 4.0*hBL*u_star) + pi2*Kv_rest / hBL**2 + if (absf*hBL <= 4.0e-16*u_star) then + Kv_eff = pi2 * (Kv_rest + 0.25*vonKar*hBL*u_star) + else + Kv_eff = pi2 * (Kv_rest + vonKar*u_star**2*hBL / (absf*hBL + 4.0*u_star)) + endif + growth_time = (restrat_coef*0.0625) * ((hBL**2*(hBL**2*absf + 2.0*Kv_eff)) / ((hBL**2*absf)**2 + Kv_eff**2)) + endif + +end function growth_time !> Initialize the mixed layer restratification module logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, restart_CS) @@ -843,12 +846,14 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure ! Local variables real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. + ! a restart file to the internal representation in this run [nondim]? + real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. [kg T s-1 H-1 L-2 ~> kg m-3 or 1] + real :: omega ! The Earth's rotation rate [T-1 ~> s-1]. + real :: ustar_min_dflt ! The default value for RESTRAT_USTAR_MIN [Z T-1 ~> m s-1] ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j @@ -931,9 +936,20 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "used in the MLE scheme. This simply multiplies MLD wherever used.",& units="nondim", default=1.0) endif - call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", & - units="s-1", default=7.2921e-5, scale=US%T_to_s) + call get_param(param_file, mdl, "KV_RESTRAT", CS%Kv_restrat, & + "A small viscosity that sets a floor on the momentum mixing rate during "//& + "restratification. If this is positive, it will prevent some possible "//& + "divisions by zero even if ustar, RESTRAT_USTAR_MIN, and f are all 0.", & + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) + call get_param(param_file, mdl, "OMEGA", omega, & + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) + ustar_min_dflt = 2.0e-4 * omega * (GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) + call get_param(param_file, mdl, "RESTRAT_USTAR_MIN", CS%ustar_min, & + "The minimum value of ustar that will be used by the mixed layer "//& + "restratification module. This can be tiny, but if this is greater than 0, "//& + "it will prevent divisions by zero when f and KV_RESTRAT are zero.", & + units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) CS%diag => diag @@ -994,13 +1010,14 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, end function mixedlayer_restrat_init !> Allocate and register fields in the mixed layer restratification structure for restarts -subroutine mixedlayer_restrat_register_restarts(HI, GV, param_file, CS, restart_CS) +subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables logical :: mixedlayer_restrat_init @@ -1011,9 +1028,9 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, param_file, CS, restart_ if (.not. mixedlayer_restrat_init) return call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & - default=0., do_not_log=.true.) + units="s", default=0., scale=US%s_to_T, do_not_log=.true.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & - default=0., do_not_log=.true.) + units="s", default=0., scale=US%s_to_T, do_not_log=.true.) if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then ! CS%MLD_filtered is used to keep a running mean of the PBL's actively mixed MLD. allocate(CS%MLD_filtered(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) From b2ba9d91720fc8868503ae5e95aa0f1ce1940680 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Dec 2022 18:48:39 -0500 Subject: [PATCH 059/213] (*)Correct two rescaling bugs in MOM_EOS Corrected the pressure rescaling in calculate_density_second_derivs_scalar() that had been using an uninitialized variable. Also corrected the dimensional rescaling of dSVdT and dSVdS in calc_spec_vol_derivs_1d when temperature and salinity are being rescaled but density is not. Fortunately these do not seem to impact solutions in any production runs, and there do not appear to be any calls to calculate_density_second_derivs_scalar(). Also added checksum calls for tv%varT, tv%varS and tv%covarTS to MOM_thermo_chksum when these elements of the thermovar type are associated. Comments were also added describing the units of a number of internal variables or conversion factor in the MOM_EOS module. All answers in the MOM6-examples test suite are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 6 ++- src/equation_of_state/MOM_EOS.F90 | 65 ++++++++++++++++++++---------- 2 files changed, 48 insertions(+), 23 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index aa080e1e8e..871de51632 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -92,7 +92,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is !! used to rescale u and v if present. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully @@ -130,6 +130,10 @@ subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) scale=US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, & scale=US%S_to_ppt*US%RZ_to_kg_m2) + if (associated(tv%varT)) call hchksum(tv%varT, mesg//" varT", G%HI, haloshift=hs, scale=US%C_to_degC**2) + if (associated(tv%varS)) call hchksum(tv%varS, mesg//" varS", G%HI, haloshift=hs, scale=US%S_to_ppt**2) + if (associated(tv%covarTS)) call hchksum(tv%covarTS, mesg//" covarTS", G%HI, haloshift=hs, & + scale=US%S_to_ppt*US%C_to_degC) end subroutine MOM_thermo_chksum diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index c946ddaff8..27484aa536 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -126,16 +126,18 @@ module MOM_EOS real :: dTFr_dp !< The derivative of freezing point with pressure [degC Pa-1] ! Unit conversion factors (normally used for dimensional testing but could also allow for -! change of units of arguments to functions) - real :: m_to_Z = 1. !< A constant that translates distances in meters to the units of depth. - real :: kg_m3_to_R = 1. !< A constant that translates kilograms per meter cubed to the units of density. - real :: R_to_kg_m3 = 1. !< A constant that translates the units of density to kilograms per meter cubed. - real :: RL2_T2_to_Pa = 1.!< Convert pressures from R L2 T-2 to Pa. - real :: L_T_to_m_s = 1. !< Convert lateral velocities from L T-1 to m s-1. - real :: degC_to_C = 1. !< A constant that translates degrees Celsius to the units of temperature. - real :: C_to_degC = 1. !< A constant that translates the units of temperature to degrees Celsius. - real :: ppt_to_S = 1. !< A constant that translates parts per thousand to the units of salinity. - real :: S_to_ppt = 1. !< A constant that translates the units of salinity to parts per thousand. +! change of units of arguments to functions + real :: m_to_Z = 1. !< A constant that translates distances in meters to the units of depth [Z m-1 ~> 1] + real :: kg_m3_to_R = 1. !< A constant that translates kilograms per meter cubed to the + !! units of density [R m3 kg-1 ~> 1] + real :: R_to_kg_m3 = 1. !< A constant that translates the units of density to + !! kilograms per meter cubed [kg m-3 R-1 ~> 1] + real :: RL2_T2_to_Pa = 1.!< Convert pressures from R L2 T-2 to Pa [Pa T2 R-1 L-2 ~> 1] + real :: L_T_to_m_s = 1. !< Convert lateral velocities from L T-1 to m s-1 [m T s-1 L-1 ~> 1] + real :: degC_to_C = 1. !< A constant that translates degrees Celsius to the units of temperature [C degC-1 ~> 1] + real :: C_to_degC = 1. !< A constant that translates the units of temperature to degrees Celsius [degC C-1 ~> 1] + real :: ppt_to_S = 1. !< A constant that translates parts per thousand to the units of salinity [S ppt-1 ~> 1] + real :: S_to_ppt = 1. !< A constant that translates the units of salinity to parts per thousand [ppt S-1 ~> 1] ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -219,7 +221,11 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in !! combination with scaling stored in EOS [various] ! Local variables - real :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p + real :: d2RdTT ! Second derivative of density with temperature [kg m-3 degC-2] + real :: d2RdST ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] + real :: d2RdSS ! Second derivative of density with salinity [kg m-3 ppt-2] + real :: d2RdSp ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] + real :: d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: T_scale ! A factor to convert temperature to units of degC [degC C-1 ~> 1] real :: S_scale ! A factor to convert salinity to units of ppt [ppt S-1 ~> 1] @@ -309,7 +315,12 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output !! density, perhaps to other units than kg m-3 [various] ! Local variables - real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p + real, dimension(size(T)) :: & + d2RdTT, & ! Second derivative of density with temperature [kg m-3 degC-2] + d2RdST, & ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] + d2RdSS, & ! Second derivative of density with salinity [kg m-3 ppt-2] + d2RdSp, & ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] + d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] integer :: j select case (EOS%form_of_EOS) @@ -423,7 +434,12 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] real, dimension(size(rho)) :: Ta ! Temperature converted to [degC] real, dimension(size(rho)) :: Sa ! Salinity converted to [ppt] - real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p + real, dimension(size(T)) :: & + d2RdTT, & ! Second derivative of density with temperature [kg m-3 degC-2] + d2RdST, & ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] + d2RdSS, & ! Second derivative of density with salinity [kg m-3 ppt-2] + d2RdSp, & ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] + d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] integer :: i, is, ie, npts if (present(dom)) then @@ -670,7 +686,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca ! Local variables real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: j p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale @@ -1028,7 +1044,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! in combination with scaling stored in EOS [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: pres ! Pressure converted to [Pa] real :: Ta ! Temperature converted to [degC] real :: Sa ! Salinity converted to [ppt] @@ -1061,9 +1076,9 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr drho_dT_dP = rho_scale * drho_dT_dP endif - if (p_scale /= 1.0) then - drho_dS_dP = p_scale * drho_dS_dP - drho_dT_dP = p_scale * drho_dT_dP + if (EOS%RL2_T2_to_Pa /= 1.0) then + drho_dS_dP = EOS%RL2_T2_to_Pa * drho_dS_dP + drho_dT_dP = EOS%RL2_T2_to_Pa * drho_dT_dP endif if (EOS%C_to_degC /= 1.0) then @@ -1173,7 +1188,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca if (present(scale)) spv_scale = spv_scale * scale dSVdT_scale = spv_scale * EOS%C_to_degC dSVdS_scale = spv_scale * EOS%S_to_ppt - if (spv_scale /= 1.0) then ; do i=is,ie + if ((dSVdT_scale /= 1.0) .or. (dSVdS_scale /= 1.0)) then ; do i=is,ie dSV_dT(i) = dSVdT_scale * dSV_dT(i) dSV_dS(i) = dSVdS_scale * dSV_dS(i) enddo ; endif @@ -1252,7 +1267,12 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) ! Local variables ! These arrays use the same units as their counterparts in calcluate_compress_1d. - real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa + real, dimension(1) :: pa ! Pressure in a size-1 1d array [R L2 T-2 ~> Pa] + real, dimension(1) :: Ta ! Temperature in a size-1 1d array [C ~> degC] + real, dimension(1) :: Sa ! Salinity in a size-1 1d array [S ~> ppt] + real, dimension(1) :: rhoa ! In situ density in a size-1 1d array [R ~> kg m-3] + real, dimension(1) :: drho_dpa ! The partial derivative of density with pressure (also the + ! inverse of the square of sound speed) in a 1d array [T2 L-2 ~> s2 m-2] Ta(1) = T ; Sa(1) = S ; pa(1) = pressure @@ -1629,11 +1649,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(inout) :: S !< Salinity [S ~> ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & - intent(in) :: mask_z !< 3d mask regulating which points to convert. + intent(in) :: mask_z !< 3d mask regulating which points to convert [nondim] type(EOS_type), intent(in) :: EOS !< Equation of state structure + real :: gsw_sr_from_sp ! Reference salinity after conversion from practical salinity [ppt] + real :: gsw_ct_from_pt ! Conservative temperature after conversion from potential temperature [degC] integer :: i, j, k - real :: gsw_sr_from_sp, gsw_ct_from_pt if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return From 5db4d0c901951d18426fcb8210b747a42d94128b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Dec 2022 08:54:13 -0500 Subject: [PATCH 060/213] +(*)Fix numerous issues with MOM_stoch_eos Corrected several bugs that would prevent cases with STOCH_EOS = True or that set a non-negative value of STANLEY_COEF from running at all. There was also extensive refactoring of the MOM_stoch_eos.F90 code. Specifically this commit makes the following changes: - The new routine stoch_eos_register_restarts was added to register the restart field associated with the MOM_stoch_EOS module before the restarts are read and before restart_registry_lock is called, which was causing any test case with STOCH_EOS=True or a positive value of STANLEY_COEF to have a fatal error. - Added a missing dimensional rescaling factor in the get_param call for KD_SMOOTH in MOM_stoch_eos_init, which would have caused cases exercising the MOM_stoch_eos options to fail the dimensional consistency tests. - MOM_stoch_eos_init was changed from a subroutine into a function that returns a logical value indicating whether this routine is used further. The order of the arguments was modified to match the order used in every other init call. - The new routine post_stoch_eos_diags was added to write diagnostics associated with the stoch_eos module. - The MOM_stoch_eos_CS type was made opaque. - The unused diag argument was removed from MOM_stoch_eos_run. - Unit arguments were added to the get_param calls for STANLEY_COEFF and STANLEY_A. - Four arrays in the MOM_stoch_eos_CS type that had been declared to optionally use static memory allocation were modified to be simple allocatables, as they are not used in the vast majority of MOM6 cases, and there is no reason to always assign memory to them. - The register_restart_field call for "stoch_eos_pattern" was revised to use the newer, more direct form rather than working via a vardesc type. - Return statements were added to several of the MOM_stoch_eos routines in the cases where they are not supposed to do anything. - The comments describing several real variables in the MOM_stoch_eos module were added or modified to describe their units using the standard format. - The module use statements at the start of the MOM_stoch_eos module were updated to reflect these changes. There were also parallel changes in MOM.F90: - Added use_stochastic_EOS element to the MOM_control_struct to indicate whether the stoch_eos calls are to be used. - MOM_stoch_eos_init is only called if temperature and salinities are state variables, as it makes no sense to call it otherwise. - Calls to stoch_eos routines were updates to reflect the new interfaces. - The contents of the MOM_stoch_eos_CS type are no longer used in MOM.F90. All answers are bitwise identical in cases that do not use dimensional rescaling, but answers will change (be corrected) in some cases that do use dimensional consistency tests. Several public interfaces to MOM_stoch_eos routines were altered, and there are changes to multiple MOM_parameter_doc files due to the new units, and due to the fact that stoch_EOS parameters are no longer being logged in cases where they are meaningless. --- src/core/MOM.F90 | 26 +++-- src/core/MOM_stoch_eos.F90 | 191 ++++++++++++++++++++++--------------- 2 files changed, 132 insertions(+), 85 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index d1fd8619da..8d7caf83ed 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -114,7 +114,8 @@ module MOM use MOM_shared_initialization, only : write_ocean_geometry_file use MOM_sponge, only : init_sponge_diags, sponge_CS use MOM_state_initialization, only : MOM_initialize_state -use MOM_stoch_eos, only : MOM_stoch_eos_init,MOM_stoch_eos_run,MOM_stoch_eos_CS,mom_calc_varT +use MOM_stoch_eos, only : MOM_stoch_eos_init, MOM_stoch_eos_run, MOM_stoch_eos_CS +use MOM_stoch_eos, only : stoch_EOS_register_restarts, post_stoch_EOS_diags, mom_calc_varT use MOM_sum_output, only : write_energy, accumulate_net_input use MOM_sum_output, only : MOM_sum_output_init, MOM_sum_output_end use MOM_sum_output, only : sum_output_CS @@ -288,6 +289,7 @@ module MOM logical :: thickness_diffuse_first !< If true, diffuse thickness before dynamics. logical :: mixedlayer_restrat !< If true, use submesoscale mixed layer restratifying scheme. logical :: useMEKE !< If true, call the MEKE parameterization. + logical :: use_stochastic_EOS !< If true, use the stochastic EOS parameterizations. logical :: useWaves !< If true, update Stokes drift logical :: use_p_surf_in_EOS !< If true, always include the surface pressure contributions !! in equation of state calculations. @@ -1079,12 +1081,12 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call cpu_clock_begin(id_clock_dynamics) call cpu_clock_begin(id_clock_stoch) - if (CS%stoch_eos_CS%use_stoch_eos) call MOM_stoch_eos_run(G,u,v,dt,Time_local,CS%stoch_eos_CS,CS%diag) + if (CS%use_stochastic_EOS) call MOM_stoch_eos_run(G, u, v, dt, Time_local, CS%stoch_eos_CS) call cpu_clock_end(id_clock_stoch) call cpu_clock_begin(id_clock_varT) - if (CS%stoch_eos_CS%stanley_coeff >= 0.0) then - call MOM_calc_varT(G,GV,h,CS%tv,CS%stoch_eos_CS,dt) - call pass_var(CS%tv%varT, G%Domain,clock=id_clock_pass,halo=1) + if (CS%use_stochastic_EOS) then + call MOM_calc_varT(G, GV, h, CS%tv, CS%stoch_eos_CS, dt) + if (associated(CS%tv%varT)) call pass_var(CS%tv%varT, G%Domain, clock=id_clock_pass, halo=1) endif call cpu_clock_end(id_clock_varT) @@ -1297,9 +1299,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (IDs%id_u > 0) call post_data(IDs%id_u, u, CS%diag) if (IDs%id_v > 0) call post_data(IDs%id_v, v, CS%diag) if (IDs%id_h > 0) call post_data(IDs%id_h, h, CS%diag) - if (CS%stoch_eos_CS%id_stoch_eos > 0) call post_data(CS%stoch_eos_CS%id_stoch_eos, CS%stoch_eos_CS%pattern, CS%diag) - if (CS%stoch_eos_CS%id_stoch_phi > 0) call post_data(CS%stoch_eos_CS%id_stoch_phi, CS%stoch_eos_CS%phi, CS%diag) - if (CS%stoch_eos_CS%id_tvar_sgs > 0) call post_data(CS%stoch_eos_CS%id_tvar_sgs, CS%tv%varT, CS%diag) + if (CS%use_stochastic_EOS) call post_stoch_EOS_diags(CS%stoch_eos_CS, CS%tv, CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) @@ -2679,6 +2679,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call waves_register_restarts(waves_CSp, HI, GV, param_file, restart_CSp) endif + if (use_temperature) then + call stoch_EOS_register_restarts(HI, param_file, CS%stoch_eos_CS, restart_CSp) + endif + call callTree_waypoint("restart registration complete (initialize_MOM)") call restart_registry_lock(restart_CSp) @@ -2964,7 +2968,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call interface_filter_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%interface_filter_CSp) new_sim = is_new_run(restart_CSp) - call MOM_stoch_eos_init(G,Time,param_file,CS%stoch_eos_CS,restart_CSp,diag) + if (use_temperature) then + CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, US, param_file, diag, CS%stoch_eos_CS, restart_CSp) + else + CS%use_stochastic_EOS = .false. + endif if (CS%use_porbar) & call porous_barriers_init(Time, US, param_file, diag, CS%por_bar_CS) diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 index 2f67077f1e..deb878e99c 100644 --- a/src/core/MOM_stoch_eos.F90 +++ b/src/core/MOM_stoch_eos.F90 @@ -2,46 +2,44 @@ module MOM_stoch_eos ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_file_parser, only : get_param, param_file_type -use MOM_random, only : PRNG,random_2d_constructor,random_2d_norm -use MOM_time_manager, only : time_type -use MOM_io, only : vardesc, var_desc -use MOM_restart, only : MOM_restart_CS,is_new_run -use MOM_diag_mediator, only : register_diag_field,post_data,diag_ctrl,safe_alloc_ptr -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_restart, only : register_restart_field -use MOM_isopycnal_slopes,only : vert_fill_TS -!use random_numbers_mod, only : getRandomNumbers,initializeRandomNumberStream,randomNumberStream +use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL +use MOM_file_parser, only : get_param, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_isopycnal_slopes, only : vert_fill_TS +use MOM_random, only : PRNG, random_2d_constructor, random_2d_norm +use MOM_restart, only : MOM_restart_CS, register_restart_field, is_new_run, query_initialized +use MOM_time_manager, only : time_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +!use random_numbers_mod, only : getRandomNumbers, initializeRandomNumberStream, randomNumberStream implicit none; private #include public MOM_stoch_eos_init public MOM_stoch_eos_run +public stoch_EOS_register_restarts +public post_stoch_EOS_diags public MOM_calc_varT !> Describes parameters of the stochastic component of the EOS !! correction, described in Stanley et al. JAMES 2020. -type, public :: MOM_stoch_eos_CS - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: l2_inv - !< One over sum of the T cell side side lengths squared - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: rgauss - !< nondimensional random Gaussian - real :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 - real :: amplitude=0.624499 !< Nondimensional std dev of Gaussian +type, public :: MOM_stoch_eos_CS ; private + real, allocatable :: l2_inv(:,:) !< One over sum of the T cell side side lengths squared [L-2 ~> m-2] + real, allocatable :: rgauss(:,:) !< nondimensional random Gaussian [nondim] + real :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 [nondim] + real :: amplitude=0.624499 !< Nondimensional standard deviation of Gaussian [nondim] integer :: seed !< PRNG seed type(PRNG) :: rn_CS !< PRNG control structure - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: pattern - !< Random pattern for stochastic EOS [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: phi - !< temporal correlation stochastic EOS [nondim] + real, allocatable :: pattern(:,:) !< Random pattern for stochastic EOS [nondim] + real, allocatable :: phi(:,:) !< temporal correlation stochastic EOS [nondim] logical :: use_stoch_eos!< If true, use the stochastic equation of state (Stanley et al. 2020) real :: stanley_coeff !< Coefficient correlating the temperature gradient - !! and SGS T variance; if <0, turn off scheme in all codes - real :: stanley_a !< a in exp(aX) in stochastic coefficient + !! and SGS T variance [nondim]; if <0, turn off scheme in all codes + real :: stanley_a !< a in exp(aX) in stochastic coefficient [nondim] real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] !>@{ Diagnostic IDs @@ -52,61 +50,64 @@ module MOM_stoch_eos contains -!> Initializes MOM_stoch_eos module. -subroutine MOM_stoch_eos_init(G, Time, param_file, CS, restart_CS, diag) - type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(time_type), intent(in) :: Time !< Time for stochastic process - type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics +!> Initializes MOM_stoch_eos module, returning a logical indicating whether this module will be used. +logical function MOM_stoch_eos_init(Time, G, US, param_file, diag, CS, restart_CS) + type(time_type), intent(in) :: Time !< Time for stochastic process + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(diag_ctrl), target, intent(inout) :: diag !< Structure used to control diagnostics + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! local variables integer :: i,j - type(vardesc) :: vd - CS%seed=0 - ! contants - !pi=2*acos(0.0) + + MOM_stoch_eos_init = .false. + + CS%seed = 0 + call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", CS%use_stoch_eos, & "If true, stochastic perturbations are applied "//& "to the EOS in the PGF.", default=.false.) call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, & "Coefficient correlating the temperature gradient "//& - "and SGS T variance.", default=-1.0) + "and SGS T variance.", units="nondim", default=-1.0) call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", CS%stanley_a, & "Coefficient a which scales chi in stochastic perturbation of the "//& - "SGS T variance.", default=1.0) + "SGS T variance.", units="nondim", default=1.0, & + do_not_log=((CS%stanley_coeff<0.0) .or. .not.CS%use_stoch_eos)) call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6) + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s, & + do_not_log=(CS%stanley_coeff<0.0)) - !don't run anything if STANLEY_COEFF < 0 + ! Don't run anything if STANLEY_COEFF < 0 if (CS%stanley_coeff >= 0.0) then + if (.not.allocated(CS%pattern)) call MOM_error(FATAL, & + "MOM_stoch_eos_CS%pattern is not allocated when it should be, suggesting that "//& + "stoch_EOS_register_restarts() has not been called before MOM_stoch_eos_init().") - ALLOC_(CS%pattern(G%isd:G%ied,G%jsd:G%jed)) ; CS%pattern(:,:) = 0.0 - vd = var_desc("stoch_eos_pattern","nondim","Random pattern for stoch EOS",'h','1') - call register_restart_field(CS%pattern, vd, .false., restart_CS) - ALLOC_(CS%phi(G%isd:G%ied,G%jsd:G%jed)) ; CS%phi(:,:) = 0.0 - ALLOC_(CS%l2_inv(G%isd:G%ied,G%jsd:G%jed)) - ALLOC_(CS%rgauss(G%isd:G%ied,G%jsd:G%jed)) + allocate(CS%phi(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%l2_inv(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%rgauss(G%isd:G%ied,G%jsd:G%jed), source=0.0) call get_param(param_file, "MOM_stoch_eos", "SEED_STOCH_EOS", CS%seed, & "Specfied seed for random number sequence ", default=0) call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed) call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss) - ! fill array with approximation of grid area needed for decorrelation - ! time-scale calculation + ! fill array with approximation of grid area needed for decorrelation time-scale calculation do j=G%jsc,G%jec do i=G%isc,G%iec - CS%l2_inv(i,j)=1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) + CS%l2_inv(i,j) = 1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) enddo enddo - if (is_new_run(restart_CS)) then - do j=G%jsc,G%jec - do i=G%isc,G%iec - CS%pattern(i,j)=CS%amplitude*CS%rgauss(i,j) - enddo - enddo + + if (.not.query_initialized(CS%pattern, "stoch_eos_pattern", restart_CS) .or. & + is_new_run(restart_CS)) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%pattern(i,j) = CS%amplitude*CS%rgauss(i,j) + enddo ; enddo endif !register diagnostics @@ -120,10 +121,32 @@ subroutine MOM_stoch_eos_init(G, Time, param_file, CS, restart_CS, diag) endif endif -end subroutine MOM_stoch_eos_init + ! This module is only used if explicitly enabled or a positive correlation coefficient is set. + MOM_stoch_eos_init = CS%use_stoch_eos .or. (CS%stanley_coeff >= 0.0) + +end function MOM_stoch_eos_init + +!> Register fields related to the stoch_EOS module for resarts +subroutine stoch_EOS_register_restarts(HI, param_file, CS, restart_CS) + type(hor_index_type), intent(in) :: HI !< Horizontal index structure + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + + call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, & + "Coefficient correlating the temperature gradient "//& + "and SGS T variance.", units="nondim", default=-1.0, do_not_log=.true.) + + if (CS%stanley_coeff >= 0.0) then + allocate(CS%pattern(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.0) + call register_restart_field(CS%pattern, "stoch_eos_pattern", .false., restart_CS, & + "Random pattern for stoch EOS", "nondim") + endif + +end subroutine stoch_EOS_register_restarts !> Generates a pattern in space and time for the ocean stochastic equation of state -subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) +subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. @@ -132,12 +155,14 @@ subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) real, intent(in) :: delt !< Time step size for AR1 process [T ~> s]. type(time_type), intent(in) :: Time !< Time for stochastic process type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics ! local variables - integer :: i,j - integer :: yr,mo,dy,hr,mn,sc - real :: phi,ubar,vbar + real :: ubar, vbar ! Averaged velocities [L T-1 ~> m s-1] + real :: phi ! A temporal correlation factor [nondim] + integer :: i, j + + ! Return without doing anything if this capability is not enabled. + if (.not.CS%use_stoch_eos) return call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed) call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss) @@ -145,16 +170,28 @@ subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) ! advance AR(1) do j=G%jsc,G%jec do i=G%isc,G%iec - ubar=0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) - vbar=0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) - phi=exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j))) - CS%pattern(i,j)=phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j) - CS%phi(i,j)=phi + ubar = 0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) + vbar = 0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) + phi = exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j))) + CS%pattern(i,j) = phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j) + CS%phi(i,j) = phi enddo enddo end subroutine MOM_stoch_eos_run +!> Write out any diagnostics related to this module. +subroutine post_stoch_EOS_diags(CS, tv, diag) + type(MOM_stoch_eos_CS), intent(in) :: CS !< Stochastic control structure + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(diag_ctrl), intent(inout) :: diag !< Structure to control diagnostics + + if (CS%id_stoch_eos > 0) call post_data(CS%id_stoch_eos, CS%pattern, diag) + if (CS%id_stoch_phi > 0) call post_data(CS%id_stoch_phi, CS%phi, diag) + if (CS%id_tvar_sgs > 0) call post_data(CS%id_tvar_sgs, tv%varT, diag) + +end subroutine post_stoch_EOS_diags + !> Computes a parameterization of the SGS temperature variance subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -171,15 +208,17 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) !! in massless layers filled vertically by diffusion. S !> The filled salinity [S ~> ppt], with the values in !! in massless layers filled vertically by diffusion. - integer :: i, j, k real :: hl(5) !> Copy of local stencil of H [H ~> m] real :: dTdi2, dTdj2 !> Differences in T variance [C2 ~> degC2] + integer :: i, j, k + + ! Nothing happens if a negative correlation coefficient is set. + if (CS%stanley_coeff < 0.0) return ! This block does a thickness weighted variance calculation and helps control for ! extreme gradients along layers which are vanished against topography. It is ! still a poor approximation in the interior when coordinates are strongly tilted. - if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke) - + if (.not. associated(tv%varT)) allocate(tv%varT(G%isd:G%ied, G%jsd:G%jed, GV%ke), source=0.0) call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.) do k=1,G%ke @@ -193,12 +232,12 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) ! SGS variance in i-direction [C2 ~> degC2] dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & - + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & - ) * G%dxT(i,j) * 0.5 )**2 + + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & + ) * G%dxT(i,j) * 0.5 )**2 ! SGS variance in j-direction [C2 ~> degC2] dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & - + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & - ) * G%dyT(i,j) * 0.5 )**2 + + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & + ) * G%dyT(i,j) * 0.5 )**2 tv%varT(i,j,k) = CS%stanley_coeff * ( dTdi2 + dTdj2 ) ! Turn off scheme near land tv%varT(i,j,k) = tv%varT(i,j,k) * (minval(hl) / (maxval(hl) + GV%H_subroundoff)) @@ -210,7 +249,7 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) do k=1,G%ke do j=G%jsc,G%jec do i=G%isc,G%iec - tv%varT(i,j,k) = exp (CS%stanley_a * CS%pattern(i,j)) * tv%varT(i,j,k) + tv%varT(i,j,k) = exp(CS%stanley_a * CS%pattern(i,j)) * tv%varT(i,j,k) enddo enddo enddo From 73add03eb913467cf8aa6baa1262a3671a995998 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Dec 2022 08:55:49 -0500 Subject: [PATCH 061/213] (*)Correct USE_STANLEY domain extents in EOS calls Corrected the domain extents used in EOS calls that are triggered with USE_STANLEY_GM and USE_STANLEY_ISO. These bugs were accidentally introduced when the changes adding the MOM_stoch_eos code to the main branch of MOM6 were merged with changes on the dev/gfdl branch. Also added a test for cases when USE_STANLEY_GM is set to true but STANLEY_COEF is negative to reset the internal versions of this flag to false with a sensible warning message rather than encountering segmentation faults. All solutions are bitwise identical in cases that worked before. --- src/core/MOM_isopycnal_slopes.F90 | 92 +++++++++---------- .../lateral/MOM_thickness_diffuse.F90 | 38 +++++--- 2 files changed, 71 insertions(+), 59 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index b5bd51d75a..07dd19b0a6 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -3,12 +3,12 @@ module MOM_isopycnal_slopes ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density_derivs -use MOM_EOS, only : calculate_density_second_derivs +use MOM_debugging, only : hchksum, uvchksum +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density_derivs, calculate_density_second_derivs, EOS_domain use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S @@ -28,13 +28,12 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return other stratification dependent functions such as N^2 !! and dz*S^2*g-prime used, or calculable from factors used, during the calculation. subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stanley, & - slope_x, slope_y, N2_u, N2_v, dzu, dzv, dzSxN, dzSyN, halo, OBC) !, eta_to_m) + slope_x, slope_y, N2_u, N2_v, dzu, dzv, dzSxN, dzSyN, halo, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m] or units - !! given by 1/eta_to_m) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity @@ -61,15 +60,12 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan integer, optional, intent(in) :: halo !< Halo width over which to compute type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units - ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & ! The temperature [C ~> degC], with the values in ! in massless layers filled vertically by diffusion. - S !, & ! The filled salinity [S ~> ppt], with the values in + S ! The filled salinity [S ~> ppt], with the values in ! in massless layers filled vertically by diffusion. -! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & pres ! The pressure at an interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored. @@ -96,15 +92,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan T_hr, & ! Temperature on the interface at the h (+1) point [C ~> degC]. S_hr, & ! Salinity on the interface at the h (+1) point [S ~> ppt] pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. - real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density - real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the - ! interface times the grid spacing [R ~> kg m-3]. + real :: drdiA, drdiB ! Along layer zonal potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. + real :: drdjA, drdjB ! Along layer meridional potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. real :: hg2A, hg2B ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. - real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. + real :: wtA, wtB ! Unnormalized weights of the slopes above and below [H3 ~> m3 or kg3 m-6] + real :: wtL, wtR ! Unnormalized weights of the slopes to the left and right [H3 Z ~> m4 or kg3 m-5] real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: slope ! The slope of density surfaces, calculated in a way @@ -117,33 +115,34 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0 ! The gravitational acceleration divided by density [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] - real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances [L Z-1 ~> 1] - real :: L_to_Z ! A conversion factor between from units for lateral distances - ! to the units for e [Z L-1 ~> 1] - real :: H_to_Z ! A conversion factor from thickness units to the units of e [Z H-1 ~> 1 or m3 kg-1] logical :: present_N2_u, present_N2_v - integer, dimension(2) :: EOSdom_u, EOSdom_v ! Domains for the equation of state calculations at u and v points + logical :: local_open_u_BC, local_open_v_BC ! True if u- or v-face OBCs exist anywhere in the global domain. + integer, dimension(2) :: EOSdom_u ! The shifted I-computational domain to use for equation of + ! state calculations at u-points. + integer, dimension(2) :: EOSdom_v ! The shifted i-computational domain to use for equation of + ! state calculations at v-points. + integer, dimension(2) :: EOSdom_h1 ! The shifted i-computational domain to use for equation of + ! state calculations at h points with 1 extra halo point integer :: is, ie, js, je, nz, IsdB integer :: i, j, k integer :: l_seg - logical :: local_open_u_BC, local_open_v_BC if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + EOSdom_h1(:) = EOS_domain(G%HI, halo=halo+1) else is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + EOSdom_h1(:) = EOS_domain(G%HI, halo=1) endif + EOSdom_u(1) = is-1 - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) + EOSdom_v(:) = EOS_domain(G%HI, halo=halo) + nz = GV%ke ; IsdB = G%IsdB + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z - ! if (present(eta_to_m)) then - ! Z_to_L = eta_to_m*US%m_to_L ; H_to_Z = GV%H_to_m / eta_to_m - ! endif - L_to_Z = 1.0 / Z_to_L - dz_neglect = GV%H_subroundoff * H_to_Z + dz_neglect = GV%H_subroundoff * GV%H_to_Z local_open_u_BC = .false. local_open_v_BC = .false. @@ -221,12 +220,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan enddo ; enddo enddo - EOSdom_u(1) = is-1 - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv,h,e, & - !$OMP h_neglect,dz_neglect,Z_to_L,L_to_Z,H_to_Z,h_neglect2, & - !$OMP present_N2_u,G_Rho0,N2_u,slope_x,dzSxN,EOSdom_u,local_open_u_BC, & - !$OMP dzu,OBC,use_stanley) & + !$OMP h_neglect,dz_neglect,h_neglect2, & + !$OMP present_N2_u,G_Rho0,N2_u,slope_x,dzSxN,EOSdom_u,EOSdom_h1, & + !$OMP local_open_u_BC,dzu,OBC,use_stanley) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & @@ -259,7 +256,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is-1,ie-is+3]) + tv%eqn_of_state, dom=EOSdom_h1) endif do I=is-1,ie @@ -294,7 +291,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect @@ -318,7 +315,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = (Z_to_L*drdx)**2 + drdz**2 + mag_grad2 = (US%Z_to_L*drdx)**2 + drdz**2 if (mag_grad2 > 0.0) then slope = drdx / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -351,11 +348,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan enddo ! I enddo ; enddo ! end of j-loop - EOSdom_v(1) = is - (G%isd-1) ; EOSdom_v(2) = ie - (G%isd-1) - ! Calculate the meridional isopycnal slope. !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & - !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h,h_neglect,e,dz_neglect, & !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,dzSyN,EOSdom_v, & !$OMP dzv,local_open_v_BC,OBC,use_stanley) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & @@ -393,10 +388,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, dom=EOSdom_v) call calculate_density_second_derivs(T_hr, S_hr, pres_hr, & scrap, scrap, drho_dT_dT_hr, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, dom=EOSdom_v) endif do i=is,ie if (use_EOS) then @@ -430,7 +425,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -454,7 +449,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = (Z_to_L*drdy)**2 + drdz**2 + mag_grad2 = (US%Z_to_L*drdy)**2 + drdz**2 if (mag_grad2 > 0.0) then slope = drdy / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -513,8 +508,9 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar ! Local variables real :: ent(SZI_(G),SZK_(GV)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep [H ~> m or kg m-2]. - real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. + real :: b1(SZI_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1] + real :: d1(SZI_(G)) ! A variable used by the tridiagonal solver [nondim], d1 = 1 - c1. + real :: c1(SZI_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. real :: h0 ! A negligible thickness to allow for zero thickness layers without @@ -541,7 +537,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) enddo ; enddo ; enddo else - !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) + !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) do j=js,je do i=is,ie ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b30d24eeaf..b8d5e4c89c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -637,7 +637,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [R C-1 ~> kg m-3 degC-1] drho_dS_u ! The derivative of density with salinity at u points [R S-1 ~> kg m-3 ppt-1]. - real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ignored. + real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() + ! with various units that will be ignored [various] real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [R C-1 ~> kg m-3 degC-1] drho_dS_v, & ! The derivative of density with salinity at v points [R S-1 ~> kg m-3 ppt-1]. @@ -665,9 +666,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. - real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density - real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the - ! interface times the grid spacing [R ~> kg m-3]. + real :: drdiA, drdiB ! Along layer zonal potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. + real :: drdjA, drdjB ! Along layer meridional potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. real :: drdi_u(SZIB_(G),SZK_(GV)) ! Copy of drdi at u-points [R ~> kg m-3]. real :: drdj_v(SZI_(G),SZK_(GV)) ! Copy of drdj at v-points [R ~> kg m-3]. @@ -729,10 +731,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: diag_sfn_unlim_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction before ! applying limiters [H L2 T-1 ~> m3 s-1 or kg s-1] logical :: present_slope_x, present_slope_y, calc_derivatives - integer, dimension(2) :: EOSdom_u ! The shifted i-computational domain to use for equation of + integer, dimension(2) :: EOSdom_u ! The shifted I-computational domain to use for equation of ! state calculations at u-points. - integer, dimension(2) :: EOSdom_v ! The shifted I-computational domain to use for equation of + integer, dimension(2) :: EOSdom_v ! The shifted i-computational domain to use for equation of ! state calculations at v-points. + integer, dimension(2) :: EOSdom_h1 ! The shifted i-computational domain to use for equation of + ! state calculations at h points with 1 extra halo point logical :: use_stanley integer :: is, ie, js, je, nz, IsdB, halo integer :: i, j, k @@ -809,12 +813,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_sfn_unlim_y > 0) then ; diag_sfn_unlim_y(:,:,1) = 0.0 ; diag_sfn_unlim_y(:,:,nz+1) = 0.0 ; endif EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) + EOSdom_v(:) = EOS_domain(G%HI) + EOSdom_h1(:) = EOS_domain(G%HI, halo=1) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & !$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & !$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, & - !$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,use_stanley, Tsgs2, & + !$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1,use_stanley,Tsgs2, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & @@ -855,7 +861,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is-1,ie-is+3]) + tv%eqn_of_state, EOSdom_h1) endif do I=is-1,ie @@ -1085,7 +1091,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ! end of j-loop ! Calculate the meridional fluxes and gradients. - EOSdom_v(:) = EOS_domain(G%HI) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & @@ -1134,10 +1139,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, EOSdom_v) call calculate_density_second_derivs(T_hr, S_hr, pres_hr, & scrap, scrap, drho_dT_dT_hr, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, EOSdom_v) endif do i=is,ie if (calc_derivatives) then @@ -1971,6 +1976,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) real :: strat_floor ! A floor for buoyancy frequency in the Ferrari et al. 2010, ! streamfunction formulation, expressed as a fraction of planetary ! rotation [nondim]. + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: MEKE_GEOM_answers_2018 ! If true, use expressions in the MEKE_GEOMETRIC calculation @@ -2096,6 +2103,15 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "USE_STANLEY_GM", CS%use_stanley_gm, & "If true, turn on Stanley SGS T variance parameterization "// & "in GM code.", default=.false.) + if (CS%use_stanley_gm) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) then + call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_GM is true.") + CS%use_stanley_gm = .false. + endif + endif call get_param(param_file, mdl, "OMEGA", omega, & "The rotation rate of the earth.", & default=7.2921e-5, units="s-1", scale=US%T_to_s, do_not_log=.not.CS%use_FGNV_streamfn) From 50a22788215ef530e388e38d39e5c91d3b9eaace Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Dec 2022 08:56:22 -0500 Subject: [PATCH 062/213] (*)Correct scaling of USE_STANLEY_PGF diagnostics Corrected the diagnostics rho_pgf, rho_stanley_pgf and p_stanley to only be calculated if they would be written, give identical output when dimensional rescaling is applied, and be documented with the right units. Also added a test for cases when USE_STANLEY_GM is set to true but STANLEY_COEF is negative to reset the internal versions of this flag to false with a sensible warning message rather than encountering segmentation faults. All solutions are bitwise identical in cases that worked before, but there are changes in some diagnostics when they are dimensionally rescaled. --- src/core/MOM_PressureForce_FV.F90 | 86 +++++++++++++++++++++---------- 1 file changed, 59 insertions(+), 27 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 5fdc4a1182..854b6b788c 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -13,7 +13,7 @@ module MOM_PressureForce_FV use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain use MOM_density_integrals, only : int_density_dz, int_specific_vol_dp use MOM_density_integrals, only : int_density_dz_generic_plm, int_density_dz_generic_ppm use MOM_density_integrals, only : int_spec_vol_dp_generic_plm @@ -477,12 +477,11 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm T_t, T_b ! Top and bottom edge values for linear reconstructions ! of temperature within each layer [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - rho_pgf, rho_stanley_pgf ! Density [kg m-3] from EOS with and without SGS T variance - ! in Stanley parameterization. + rho_pgf, rho_stanley_pgf ! Density [R ~> kg m-3] from EOS with and without SGS T variance + ! in Stanley parameterization. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - p_stanley ! Pressure [Pa] estimated with Rho_0 - real :: rho_stanley_scalar ! Scalar quantity to hold density [kg m-3] in Stanley diagnostics. - real :: p_stanley_scalar ! Scalar quantity to hold pressure [Pa] in Stanley diagnostics. + p_stanley ! Pressure [R L2 T-2 ~> Pa] estimated with Rho_0 + real :: zeros(SZI_(G)) ! An array of zero values that can be used as an argument [various] real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -493,12 +492,15 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm real :: G_Rho0 ! G_Earth / Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. real :: rho_ref ! The reference density [R ~> kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. + real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure + ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 ! [nondim] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer, dimension(2) :: EOSdom_h ! The i-computational domain for the equation of state at tracer points integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k @@ -759,25 +761,43 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm endif if (CS%use_stanley_pgf) then - do j=js,je ; do i=is,ie ; - p_stanley_scalar=0.0 - do k=1, nz - p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at mid-point of layer - call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, 0.0, 0.0, 0.0, & - rho_stanley_scalar, tv%eqn_of_state) - rho_pgf(i,j,k) = rho_stanley_scalar - call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, tv%varT(i,j,k), 0.0, 0.0, & - rho_stanley_scalar, tv%eqn_of_state) - rho_stanley_pgf(i,j,k) = rho_stanley_scalar - p_stanley(i,j,k) = p_stanley_scalar - p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at bottom of layer - enddo; enddo; enddo - endif + ! Calculated diagnostics related to the Stanley parameterization + zeros(:) = 0.0 + EOSdom_h(:) = EOS_domain(G%HI) + if ((CS%id_p_stanley>0) .or. (CS%id_rho_pgf>0) .or. (CS%id_rho_stanley_pgf>0)) then + ! Find the pressure at the mid-point of each layer. + H_to_RL2_T2 = GV%g_Earth*GV%H_to_RZ + if (use_p_atm) then + do j=js,je ; do i=is,ie + p_stanley(i,j,1) = 0.5*h(i,j,1) * H_to_RL2_T2 + p_atm(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + p_stanley(i,j,1) = 0.5*h(i,j,1) * H_to_RL2_T2 + enddo ; enddo + endif + do k=2,nz ; do j=js,je ; do i=is,ie + p_stanley(i,j,k) = p_stanley(i,j,k-1) + 0.5*(h(i,j,k-1) + h(i,j,k)) * H_to_RL2_T2 + enddo ; enddo ; enddo + endif + if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag) + if (CS%id_rho_pgf>0) then + do k=1,nz ; do j=js,je + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_stanley(:,j,k), zeros, & + zeros, zeros, rho_pgf(:,j,k), tv%eqn_of_state, EOSdom_h) + enddo ; enddo + call post_data(CS%id_rho_pgf, rho_pgf, CS%diag) + endif + if (CS%id_rho_stanley_pgf>0) then + do k=1,nz ; do j=js,je + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_stanley(:,j,k), tv%varT(:,j,k), & + zeros, zeros, rho_stanley_pgf(:,j,k), tv%eqn_of_state, EOSdom_h) + enddo ; enddo + call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag) + endif + endif if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) - if (CS%id_rho_pgf>0) call post_data(CS%id_rho_pgf, rho_pgf, CS%diag) - if (CS%id_rho_stanley_pgf>0) call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag) - if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag) end subroutine PressureForce_FV_Bouss @@ -791,10 +811,14 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_FV_CS), intent(inout) :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure + + ! Local variables + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. - logical :: use_ALE + logical :: use_ALE ! If true, use the Vertical Lagrangian Remap algorithm CS%initialized = .true. CS%diag => diag ; CS%Time => Time @@ -842,12 +866,20 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS "If true, turn on Stanley SGS T variance parameterization "// & "in PGF code.", default=.false.) if (CS%use_stanley_pgf) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) then + call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_PGF is true.") + CS%use_stanley_pgf = .false. + endif + CS%id_rho_pgf = register_diag_field('ocean_model', 'rho_pgf', diag%axesTL, & - Time, 'rho in PGF', 'kg m3') + Time, 'rho in PGF', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rho_stanley_pgf = register_diag_field('ocean_model', 'rho_stanley_pgf', diag%axesTL, & - Time, 'rho in PGF with Stanley correction', 'kg m3') + Time, 'rho in PGF with Stanley correction', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_p_stanley = register_diag_field('ocean_model', 'p_stanley', diag%axesTL, & - Time, 'p in PGF with Stanley correction', 'Pa') + Time, 'p in PGF with Stanley correction', 'Pa', conversion=US%RL2_T2_to_Pa) endif if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & From 73b4ff91855e734151bc0187e6f2afad722e92aa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Dec 2022 08:57:43 -0500 Subject: [PATCH 063/213] (*)Test for inconsistent USE_STANLEY flags Also added tests for cases when USE_STANLEY_ISO or USE_STANLEY_ML are set to true but STANLEY_COEF is negative to reset the internal versions of these flags to false with a sensible warning message rather than encountering segmentation faults. All solutions are bitwise identical in cases that worked before. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 11 +++++++++++ .../lateral/MOM_mixed_layer_restrat.F90 | 11 +++++++++++ 2 files changed, 22 insertions(+) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a8928ef06c..1aede30a74 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1114,6 +1114,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! scaled by the resolution function. logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1208,6 +1210,15 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "USE_STANLEY_ISO", CS%use_stanley_iso, & "If true, turn on Stanley SGS T variance parameterization "// & "in isopycnal slope code.", default=.false.) + if (CS%use_stanley_iso) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) then + call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ISO is true.") + CS%use_stanley_iso = .false. + endif + endif if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then in_use = .true. diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 08c29c6c9e..5d87761363 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -854,6 +854,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. [kg T s-1 H-1 L-2 ~> kg m-3 or 1] real :: omega ! The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min_dflt ! The default value for RESTRAT_USTAR_MIN [Z T-1 ~> m s-1] + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j @@ -891,6 +893,15 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_stanley_ml, & "If true, turn on Stanley SGS T variance parameterization "// & "in ML restrat code.", default=.false.) + if (CS%use_stanley_ml) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) then + call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") + CS%use_stanley_ml = .false. + endif + endif call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & 'The value the von Karman constant as used for mixed layer viscosity.', & units='nondim', default=0.41) From 5a8c3334d1e1ff7be5ee1a3671b8d682f3982f20 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Dec 2022 09:13:07 -0500 Subject: [PATCH 064/213] (*)Correct scaling of DT_OBC_SEG_UPDATE_OBGC Added a missing dimensional rescaling factor in the get_param call for the recently added variable DT_OBC_SEG_UPDATE_OBGC in initialize_MOM, which would have caused certain cases to fail the dimensional consistency tests. All answers are bitwise identical in cases that do not use dimensional rescaling, but answers will change (and be corrected) in some cases that use dimensional consistency tests. --- src/core/MOM.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8d7caf83ed..2288c007c8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -300,7 +300,10 @@ module MOM !! calculated, and if it is 0, dtbt is calculated every step. type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. - real :: dt_obc_seg_period !< The time interval between OBC segment updates for OBGC tracers + real :: dt_obc_seg_period !< The time interval between OBC segment updates for OBGC + !! tracers [T ~> s], or a negative value if the segment + !! data are time-invarant, or zero to update the OBGC + !! segment data with every call to update_OBC_segment_data. type(time_type) :: dt_obc_seg_interval !< A time_time representation of dt_obc_seg_period. type(time_type) :: dt_obc_seg_time !< The next time OBC segment update is applied to OBGC tracers. @@ -2186,12 +2189,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & units="s", default=default_val, do_not_read=(dtbt > 0.0)) endif - CS%dt_obc_seg_period = -1.0 call get_param(param_file, "MOM", "DT_OBC_SEG_UPDATE_OBGC", CS%dt_obc_seg_period, & "The time between OBC segment data updates for OBGC tracers. "//& "This must be an integer multiple of DT and DT_THERM. "//& "The default is set to DT.", & - units="s", default=US%T_to_s*CS%dt, do_not_log=.not.associated(CS%OBC)) + units="s", default=US%T_to_s*CS%dt, scale=US%s_to_T, do_not_log=.not.associated(CS%OBC)) ! This is here in case these values are used inappropriately. use_frazil = .false. ; bound_salinity = .false. From 674687cd25c2b3843f6101ecf15e8c962e1302b1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Dec 2022 10:08:02 -0500 Subject: [PATCH 065/213] Rescale interface heights for MOM_IC Use dimensionally rescaled units when preparing fields to write to the MOM_IC, and then use the conversion argument to the register_restart_field call to undue this scaling, following the pattern for other calls. All answers and output are bitwise identical. --- src/core/MOM.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2288c007c8..9d0701ec2a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3217,7 +3217,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing ! various unit conversion factors type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() - real, allocatable :: z_interface(:,:,:) ! Interface heights [m] + real, allocatable :: z_interface(:,:,:) ! Interface heights [Z ~> m] call cpu_clock_begin(id_clock_init) call callTree_enter("finish_MOM_initialization()") @@ -3240,9 +3240,9 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) restart_CSp_tmp = restart_CSp call restart_registry_lock(restart_CSp_tmp, unlocked=.true.) allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1)) - call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, z_interface, dZref=G%Z_ref) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & - "Interface heights", "meter", z_grid='i') + "Interface heights", "meter", z_grid='i', conversion=US%Z_to_m) ! NOTE: write_ic=.true. routes routine to fms2 IO write_initial_conditions interface call save_restart(dirs%output_directory, Time, CS%G_in, & restart_CSp_tmp, filename=CS%IC_file, GV=GV, write_ic=.true.) From 52e0152d9b9746e421577d2e19be59fba7d152d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Dec 2022 04:44:46 -0500 Subject: [PATCH 066/213] Unit descriptions in MOM_spherical_harmonics Altered the unit descriptions in comments in the new MOM_spherical_harmonics module to use standard syntax or to indicate the relationship between the units of this input and output variables. Only comments are changed, and all answers are bitwise identical. --- .../lateral/MOM_spherical_harmonics.F90 | 50 +++++++++---------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 index 54b441fa8b..95a9df808c 100644 --- a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 +++ b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 @@ -18,9 +18,9 @@ module MOM_spherical_harmonics !> Control structure for spherical harmonic transforms type, public :: sht_CS ; private logical :: initialized = .False. !< True if this control structure has been initialized. - integer :: ndegree !< Maximum degree of the spherical harmonics [nodim]. + integer :: ndegree !< Maximum degree of the spherical harmonics [nondim]. integer :: lmax !< Number of associated Legendre polynomials of nonnegative m - !! [lmax=(ndegree+1)*(ndegree+2)/2] [nodim]. + !! [lmax=(ndegree+1)*(ndegree+2)/2] [nondim]. real, allocatable :: cos_clatT(:,:) !< Precomputed cosine of colatitude at the t-cells [nondim]. real, allocatable :: Pmm(:,:,:) !< Precomputed associated Legendre polynomials (m=n) at the t-cells [nondim]. real, allocatable :: cos_lonT(:,:,:), & !< Precomputed cosine factors at the t-cells [nondim]. @@ -46,18 +46,18 @@ subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(sht_CS), intent(inout) :: CS !< Control structure for SHT real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: var !< Input 2-D variable [] - real, intent(out) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) - real, intent(out) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) + intent(in) :: var !< Input 2-D variable [A] + real, intent(out) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) [A] + real, intent(out) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) [A] integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics !! overriding ndegree in the CS [nondim] ! local variables - integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nodim] - integer :: Ltot ! Local copy of the number of spherical harmonics [nodim] + integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nondim] + integer :: Ltot ! Local copy of the number of spherical harmonics [nondim] real, dimension(SZI_(G),SZJ_(G)) :: & - pmn, & ! Current associated Legendre polynomials of degree n and order m [nodim] - pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nodim] - pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nodim] + pmn, & ! Current associated Legendre polynomials of degree n and order m [nondim] + pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nondim] + pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nondim] integer :: i, j, k integer :: is, ie, js, je, isd, ied, jsd, jed integer :: m, n, l @@ -143,19 +143,19 @@ end subroutine spherical_harmonics_forward subroutine spherical_harmonics_inverse(G, CS, Snm_Re, Snm_Im, var, Nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(sht_CS), intent(in) :: CS !< Control structure for SHT - real, intent(in) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) - real, intent(in) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) + real, intent(in) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) [A] + real, intent(in) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) [A] real, dimension(SZI_(G),SZJ_(G)), & - intent(out) :: var !< Output 2-D variable [] + intent(out) :: var !< Output 2-D variable [A] integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics !! overriding ndegree in the CS [nondim] ! local variables - integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nodim] - real :: mFac ! A constant multiplier. mFac = 1 (if m==0) or 2 (if m>0) [nodim] + integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nondim] + real :: mFac ! A constant multiplier. mFac = 1 (if m==0) or 2 (if m>0) [nondim] real, dimension(SZI_(G),SZJ_(G)) :: & - pmn, & ! Current associated Legendre polynomials of degree n and order m [nodim] - pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nodim] - pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nodim] + pmn, & ! Current associated Legendre polynomials of degree n and order m [nondim] + pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nondim] + pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nondim] integer :: i, j, k integer :: is, ie, js, je, isd, ied, jsd, jed integer :: m, n, l @@ -210,7 +210,7 @@ subroutine spherical_harmonics_init(G, param_file, CS) type(sht_CS), intent(inout) :: CS !< Control structure for spherical harmonic transforms ! local variables - real, parameter :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) [nodim] + real, parameter :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) [nondim] real, parameter :: RADIAN = PI / 180.0 ! Degree to Radian constant [rad/degree] real, dimension(SZI_(G),SZJ_(G)) :: sin_clatT ! sine of colatitude at the t-cells [nondim]. real :: Pmm_coef ! = sqrt{ 1.0/(4.0*PI) * prod[(2k+1)/2k)] } [nondim]. @@ -305,8 +305,8 @@ end subroutine spherical_harmonics_end !> Calculates the number of real elements (cosine) of spherical harmonics given maximum degree Nd. function calc_lmax(Nd) result(lmax) - integer :: lmax !< Number of real spherical harmonic modes [nodim] - integer, intent(in) :: Nd !< Maximum degree [nodim] + integer :: lmax !< Number of real spherical harmonic modes [nondim] + integer, intent(in) :: Nd !< Maximum degree [nondim] lmax = (Nd+2) * (Nd+1) / 2 end function calc_lmax @@ -314,9 +314,9 @@ end function calc_lmax !> Calculates the one-dimensional index number at (n=0, m=m), given order m and maximum degree Nd. !! It is sequenced with degree (n) changing first and order (m) changing second. function order2index(m, Nd) result(l) - integer :: l !< One-dimensional index number [nodim] - integer, intent(in) :: m !< Current order number [nodim] - integer, intent(in) :: Nd !< Maximum degree [nodim] + integer :: l !< One-dimensional index number [nondim] + integer, intent(in) :: m !< Current order number [nondim] + integer, intent(in) :: Nd !< Maximum degree [nondim] l = ((Nd+1) + (Nd+1-(m-1)))*m/2 + 1 end function order2index @@ -379,4 +379,4 @@ end function order2index !! Schaeffer, N., 2013. Efficient spherical harmonic transforms aimed at pseudospectral numerical simulations. !! Geochemistry, Geophysics, Geosystems, 14(3), pp.751-758. !! https://doi.org/10.1002/ggge.20071 -end module MOM_spherical_harmonics \ No newline at end of file +end module MOM_spherical_harmonics From bc28a1345b94c655bc9007a517f04224a2bf53a6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Dec 2022 05:08:33 -0500 Subject: [PATCH 067/213] Correct scattered unit description syntax Corrected the syntax of the unit descriptions of 6 internal variables scattered around the code. Only comments are changed, and all answers are bitwise identical. --- src/core/MOM_open_boundary.F90 | 4 ++-- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 2 +- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- src/user/Rossby_front_2d_initialization.F90 | 2 +- src/user/user_change_diffusivity.F90 | 4 ++-- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 47d6953ce1..9bd292e796 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -5324,11 +5324,11 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) integer :: i, j, k, m, n, ntr, nz integer :: ishift, idir, jshift, jdir real :: b_in, b_out ! The 0 and 1 switch for tracer reservoirs - ! 1 if the length scale of reservoir is zero [nodim] + ! 1 if the length scale of reservoir is zero [nondim] real :: a_in, a_out ! The 0 and 1(-1) switch for reservoir source weights ! e.g. a_in is -1 only if b_in ==1 and uhr or vhr is inward ! e.g. a_out is 1 only if b_out==1 and uhr or vhr is outward - ! It's clear that a_in and a_out cannot be both non-zero [nodim] + ! It's clear that a_in and a_out cannot be both non-zero [nondim] nz = GV%ke ntr = Reg%ntr diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8257d19bd3..bb159b2199 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1993,7 +1993,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. - real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nondim] real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate ! that is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index dff879d83e..af7ceef46a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -51,7 +51,7 @@ module MOM_vert_friction real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. real :: Kv_extra_bbl !< An extra vertical viscosity in the bottom boundary layer of thickness !! Hbbl when there is not a bottom drag law in use [Z2 T-1 ~> m2 s-1]. - real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index d3d1ad2368..da18a7341c 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -257,7 +257,7 @@ real function dTdy( G, dT, lat, US ) real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] real :: dHML ! The range of the mixed layer depths [Z ~> m] real :: dHdy ! The mixed layer depth gradient [Z L-1 ~> m m-1] - real :: km_to_L ! Horizontal axis unit conversion factor when AXIS_UNITS = 'k' (1000 m) [L km-1] + real :: km_to_L ! Horizontal axis unit conversion factor when AXIS_UNITS = 'k' (1000 m) [L km-1 ~> 1000] PI = 4.0 * atan(1.0) km_to_L = 1.0e3*US%m_to_L diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 762cee5446..8ed691cc87 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -7,7 +7,7 @@ module user_change_diffusivity use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, EOS_domain @@ -29,7 +29,7 @@ module user_change_diffusivity real :: Kd_add !< The scale of a diffusivity that is added everywhere !! without any filtering or scaling [Z2 T-1 ~> m2 s-1]. real :: lat_range(4) !< 4 values that define the latitude range over which - !! a diffusivity scaled by Kd_add is added [degLat]. + !! a diffusivity scaled by Kd_add is added [degrees_N]. real :: rho_range(4) !< 4 values that define the coordinate potential !! density range over which a diffusivity scaled by !! Kd_add is added [R ~> kg m-3]. From 46a61590e5c054b0dedda3195d5a8eeb49d9a4e0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Dec 2022 06:10:19 -0500 Subject: [PATCH 068/213] +Correct MOM_wave_interface unit descriptions Corrected the descriptions of 12 subroutine argument and internal variables in MOM_wave_interface, including those of 4 arguments to Stokes_PGF, and those of 8 variables related to the Waves%ddt_Us_[xy] diagnostics, which are only enabled with the STOKES_DDT flag that is labeled in the code as "developmental". This commit also includes the addition of the correct conversion arguments to the register_diag_field calls for dudt_Stokes and dvdt_Stokes diagnostics, and to the register_restart calls for Us_x_prev and Us_y_prev. This also required the addition of a unit_scale_type argument to waves_register_restarts. All solutions are bitwise identical, and the dimensional rescaling of two diagnostics are corrected. --- src/core/MOM.F90 | 2 +- src/user/MOM_wave_interface.F90 | 56 ++++++++++++++++----------------- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 9d0701ec2a..3cac9583cb 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2678,7 +2678,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif if (present(waves_CSp)) then - call waves_register_restarts(waves_CSp, HI, GV, param_file, restart_CSp) + call waves_register_restarts(waves_CSp, HI, GV, US, param_file, restart_CSp) endif if (use_temperature) then diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 6676addc56..1a1c06018e 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -20,7 +20,7 @@ module MOM_wave_interface use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalgrid, only : verticalGrid_type -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_pair, MOM_restart_CS implicit none ; private @@ -73,27 +73,27 @@ module MOM_wave_interface !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - ddt_Us_x !< 3d time tendency of zonal Stokes drift profile [m s-1] + ddt_Us_x !< 3d time tendency of zonal Stokes drift profile [L T-2 ~> m s-2] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - ddt_Us_y !< 3d time tendency of meridional Stokes drift profile [m s-1] + ddt_Us_y !< 3d time tendency of meridional Stokes drift profile [L T-2 ~> m s-2] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_x_from_ddt !< Check of 3d zonal Stokes drift profile [m s-1] + Us_x_from_ddt !< Check of 3d zonal Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [m s-1] + Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [m s-1] + Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [L T-1 ~> m s-1] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y_prev !< 3d meridional Stokes drift profile, previous dynamics call [m s-1] + Us_y_prev !< 3d meridional Stokes drift profile, previous dynamics call [L T-1 ~> m s-1] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & @@ -450,8 +450,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar call get_param(param_file, mdl, "MIN_LANGMUIR", CS%La_min, & "A minimum value for all Langmuir numbers that is not physical, "//& "but is likely only encountered when the wind is very small and "//& - "therefore its effects should be mostly benign.", units="nondim", & - default=0.05) + "therefore its effects should be mostly benign.", & + units="nondim", default=0.05) ! Allocate and initialize ! a. Stokes driftProfiles @@ -487,9 +487,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s) if (CS%Stokes_DDT) then CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & - CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') + CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & - CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_3dstokes_y_from_ddt = register_diag_field('ocean_model','3d_stokes_y_from_ddt', & CS%diag%axesCvL,Time,'3d Stokes drift from ddt (y)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_3dstokes_x_from_ddt = register_diag_field('ocean_model','3d_stokes_x_from_ddt', & @@ -614,7 +614,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. - real, intent(in) :: dt !< Time-step for computing Stokes-tendency + real, intent(in) :: dt !< Time-step for computing Stokes-tendency [T ~> s] logical, intent(in) :: dynamics_step !< True if this call is on a dynamics step ! Local Variables @@ -629,7 +629,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) real :: PI ! 3.1415926535... real :: La ! The local Langmuir number [nondim] integer :: ii, jj, kk, b, iim1, jjm1 - real :: idt ! 1 divided by the time step + real :: idt ! 1 divided by the time step [T-1 ~> s-1] if (CS%WaveMethod==EFACTOR) return @@ -1564,13 +1564,13 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Lagrangian Velocity i-component [m s-1] + intent(in) :: u !< Lagrangian Velocity i-component [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Lagrangian Velocity j-component [m s-1] + intent(in) :: v !< Lagrangian Velocity j-component [L T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2] + intent(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv_Stokes !< PGF Stokes-shear j-component [m s-1] + intent(out) :: PFv_Stokes !< PGF Stokes-shear j-component [L T-2 ~> m s-2] type(Wave_parameters_CS), & pointer :: CS !< Surface wave related control structure. @@ -1889,10 +1889,11 @@ subroutine Waves_end(CS) end subroutine Waves_end !> Register wave restart fields. To be called before MOM_wave_interface_init -subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) +subroutine waves_register_restarts(CS, HI, GV, US, param_file, restart_CSp) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(hor_index_type), intent(inout) :: HI !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) ! Local variables @@ -1916,21 +1917,20 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) if (.not.(use_waves .or. StatisticalWaves)) return - call get_param(param_file,mdl,"STOKES_DDT",time_tendency_term, do_not_log=.true., default=.false.) + call get_param(param_file, mdl, "STOKES_DDT", time_tendency_term, do_not_log=.true., default=.false.) if (time_tendency_term) then ! Allocate wave fields needed for restart file - allocate(CS%Us_x_prev(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke)) - CS%Us_x_prev(:,:,:) = 0.0 - allocate(CS%Us_y_prev(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke)) - CS%Us_y_prev(:,:,:) = 0.0 - ! Register to restart + allocate(CS%Us_x_prev(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(CS%Us_y_prev(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) + + ! Register to restart files. If these are not found in a restart file, they stay 0. vd(1) = var_desc("Us_x_prev", "m s-1", "3d zonal Stokes drift profile",& - hor_grid='u',z_grid='L') + hor_grid='u', z_grid='L') vd(2) = var_desc("Us_y_prev", "m s-1", "3d meridional Stokes drift profile",& - hor_grid='v',z_grid='L') - call register_restart_field(CS%US_x_prev(:,:,:), vd(1), .false., restart_CSp) - call register_restart_field(CS%US_y_prev(:,:,:), vd(2), .false., restart_CSp) + hor_grid='v', z_grid='L') + call register_restart_pair(CS%US_x_prev, CS%US_y_prev, vd(1), vd(2), .false., & + restart_CSp, conversion=US%L_T_to_m_s) endif end subroutine waves_register_restarts From 92a1c3c2cc36550070ca664a81603e25da62363d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Dec 2022 10:38:25 -0500 Subject: [PATCH 069/213] (+)Correct units of INTERNAL_TIDE_SOURCE_X params Corrected and documents the units for the INTERNAL_TIDE_SOURCE_[XY] runtime parameters, and corrected the (unused) INTERNAL_TIDE_SOURCE_[XY] parameters as read by wave_structure_init to INTERNAL_TIDE_SOURCE_[IJ] and then commented this unused debugging code out. All answers are bitwise identical, but the MOM_parameter_doc files could change in cases that call int_tide_input_init or wave_structure_init. --- src/diagnostics/MOM_wave_structure.F90 | 24 +++++++++++-------- .../vertical/MOM_internal_tide_input.F90 | 15 ++++++------ 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0f97b560db..80d23eeb75 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -57,10 +57,9 @@ module MOM_wave_structure !< Squared buoyancy frequency at each interface [T-2 ~> s-2]. integer, allocatable, dimension(:,:):: num_intfaces !< Number of layer interfaces (including surface and bottom) [nondim]. - real :: int_tide_source_x !< X Location of generation site - !! for internal tide for testing (BDM) - real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) + ! logical :: int_tide_source_test !< If true, apply an arbitrary generation site for internal tide testing + ! integer :: int_tide_source_i !< I Location of generation site + ! integer :: int_tide_source_j !< J Location of generation site logical :: debug !< debugging prints end type wave_structure_CS @@ -143,7 +142,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo HxR_here !< A layer integrated density [R Z ~> kg m-2] real :: I_Hnew !< The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum !< The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real, parameter :: tol1 = 0.0001, tol2 = 0.001 + real, parameter :: tol1 = 0.0001, tol2 = 0.001 ! Nondimensional tolerances [nondim] real :: g_Rho0 !< G_Earth/Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. ! real :: rescale, I_rescale integer :: kf(SZI_(G)) @@ -281,7 +280,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo do i=is,ie ; if (cn(i,j) > 0.0) then !----for debugging, remove later---- ig = i + G%idg_offset ; jg = j + G%jdg_offset - !if (ig == CS%int_tide_source_x .and. jg == CS%int_tide_source_y) then + !if (ig == CS%int_tide_source_i .and. jg == CS%int_tide_source_j) then !----------------------------------- if (G%mask2dT(i,j) > 0.0) then @@ -762,10 +761,15 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) CS%initialized = .true. - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) + ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + ! "If true, apply an arbitrary generation site for internal tide testing", & + ! default=.false.) + ! if (CS%int_tide_source_test) then + ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_I", CS%int_tide_source_i, & + ! "I Location of generation site for internal tide", default=0) + ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_J", CS%int_tide_source_j, & + ! "J Location of generation site for internal tide", default=0) + ! endif call get_param(param_file, mdl, "DEBUG", CS%debug, & "debugging prints", default=.false.) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 9ec4c073f0..7ec612f141 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -48,13 +48,12 @@ module MOM_int_tide_input character(len=200) :: inputdir !< The directory for input files. logical :: int_tide_source_test !< If true, apply an arbitrary generation site - !! for internal tide testing (BDM) + !! for internal tide testing type(time_type) :: time_max_source !< A time for use in testing internal tides real :: int_tide_source_x !< X Location of generation site - !! for internal tide for testing (BDM) - !! for internal tide for testing (BDM) + !! for internal tide for testing [degrees_E] or [km] real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) + !! for internal tide for testing [degrees_N] or [km] integer :: int_tide_source_i !< I Location of generation site integer :: int_tide_source_j !< J Location of generation site logical :: int_tide_use_glob_ij !< Use global indices for generation site @@ -417,11 +416,11 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "INTERNAL_TIDE_USE_GLOB_IJ", CS%int_tide_use_glob_ij, & "Use global IJ for internal tide generation source test", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1., & - do_not_log=CS%int_tide_use_glob_ij) + "X Location of generation site for internal tide", & + units=G%x_ax_unit_short, default=1.0, do_not_log=CS%int_tide_use_glob_ij) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1., & - do_not_log=CS%int_tide_use_glob_ij) + "Y Location of generation site for internal tide", & + units=G%y_ax_unit_short, default=1.0, do_not_log=CS%int_tide_use_glob_ij) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_I", CS%int_tide_source_i, & "I Location of generation site for internal tide", default=0, & do_not_log=.not.CS%int_tide_use_glob_ij) From 92af13feab5f04cba2934cda5b3850beab43e4fe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:27:52 -0500 Subject: [PATCH 070/213] +Standardize user module axis unit documentation Standardized documentation of axis-related variable units in user modules. Some of these use the new G%x_ax_unit_short elements to automatically write the AXIS_UNITS-dependent units into the MOM_parameter_doc files. All answers are bitwise identical but there are minor changes in some MOM_parameter_doc files. --- src/tracer/oil_tracer.F90 | 4 ++-- src/user/BFB_surface_forcing.F90 | 8 ++++---- src/user/basin_builder.F90 | 2 +- src/user/external_gwave_initialization.F90 | 10 +++++----- src/user/user_change_diffusivity.F90 | 2 +- 5 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 4d828decad..544188bb7a 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -126,10 +126,10 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) "found in the restart files of a restarted run.", & default=.false.) call get_param(param_file, mdl, "OIL_SOURCE_LONGITUDE", CS%oil_source_longitude, & - "The geographic longitude of the oil source.", units="degrees E", & + "The geographic longitude of the oil source.", units="degrees_E", & fail_if_missing=.true.) call get_param(param_file, mdl, "OIL_SOURCE_LATITUDE", CS%oil_source_latitude, & - "The geographic latitude of the oil source.", units="degrees N", & + "The geographic latitude of the oil source.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "OIL_SOURCE_LAYER", CS%oil_source_k, & "The layer into which the oil is introduced, or a "//& diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 38361ab070..818fa63659 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -31,8 +31,8 @@ module BFB_surface_forcing real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: SST_s !< SST at the southern edge of the linear forcing ramp [C ~> degC] real :: SST_n !< SST at the northern edge of the linear forcing ramp [C ~> degC] - real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degLat] - real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degLat] + real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degrees_N] or [km] + real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degrees_N] or [km] real :: drho_dt !< Rate of change of density with temperature [R C-1 ~> kg m-3 degC-1]. !! Note that temperature is being used as a dummy variable here. !! All temperatures are converted into density. @@ -206,10 +206,10 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LFR_SLAT", CS%lfrslat, & "Southern latitude where the linear forcing ramp begins.", & - units="degrees", default=20.0) + units=G%y_ax_unit_short, default=20.0) call get_param(param_file, mdl, "LFR_NLAT", CS%lfrnlat, & "Northern latitude where the linear forcing ramp ends.", & - units="degrees", default=40.0) + units=G%y_ax_unit_short, default=40.0) call get_param(param_file, mdl, "SST_S", CS%SST_s, & "SST at the southern edge of the linear forcing ramp.", & units="degC", default=20.0, scale=US%degC_to_C) diff --git a/src/user/basin_builder.F90 b/src/user/basin_builder.F90 index 9a4974807f..42083b2672 100644 --- a/src/user/basin_builder.F90 +++ b/src/user/basin_builder.F90 @@ -34,7 +34,7 @@ subroutine basin_builder_topography(D, G, param_file, max_depth) character(len=17) :: pname1, pname2 ! For construction of parameter names character(len=20) :: funcs ! Basin build function real, dimension(20) :: pars ! Parameters for each function - real :: lon ! Longitude [degrees_E} + real :: lon ! Longitude [degrees_E] real :: lat ! Latitude [degrees_N] integer :: i, j, n, n_funcs diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index ec507e181b..554440dbcb 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -39,7 +39,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: ssh_anomaly_height ! Vertical height of ssh anomaly [Z ~> m] - real :: ssh_anomaly_width ! Lateral width of anomaly [degrees] + real :: ssh_anomaly_width ! Lateral width of anomaly, often in [km] or [degrees_E] character(len=40) :: mdl = "external_gwave_initialize_thickness" ! This subroutine's name. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -53,11 +53,11 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & - "The vertical displacement of the SSH anomaly. ", units="m", scale=US%m_to_Z, & - fail_if_missing=.not.just_read, do_not_log=just_read) + "The vertical displacement of the SSH anomaly. ", & + units="m", scale=US%m_to_Z, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & - "The lateral width of the SSH anomaly. ", units="coordinate", & - fail_if_missing=.not.just_read, do_not_log=just_read) + "The lateral width of the SSH anomaly. ", & + units=G%x_ax_unit_short, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 8ed691cc87..f125da0a25 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -230,7 +230,7 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) "applied. The four values specify the latitudes at "//& "which the extra diffusivity starts to increase from 0, "//& "hits its full value, starts to decrease again, and is "//& - "back to 0.", units="degree", default=-1.0e9) + "back to 0.", units="degrees_N", default=-1.0e9) call get_param(param_file, mdl, "USER_KD_ADD_RHO_RANGE", CS%rho_range(:), & "Four successive values that define a range of potential "//& "densities over which the user-given extra diffusivity "//& From e410a937f3879352f4468e780e096e139078d00d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:28:18 -0500 Subject: [PATCH 071/213] +Document and rescale ISOMIP parameters Made 6 of the parameters describing the ISOMIP configuration into runtime parameters that are read in and rescaled via get_param calls to read ISOMIP_MAX_BEDROCK, ISOMIP_TROUGH_DEPTH, ISOMIP_BEDROCK_LENGTH, ISOMIP_TROUGH_WIDTH, ISOMIP_DOMAIN_WIDTH and ISOMIP_SIDE_WIDTH. Several of the internal variables in ISOMIP_initialize_topography were also rescaled for dimensional consistency testing, and the units of the internal variables in this same routine were documented. In addition, the default values for the ISOMIP temperatures and salinities were also rescaled. All answers are bitwise identical, but there are 6 new runtime parameters in the MOM_input files for the ISOMIP test cases. --- src/user/ISOMIP_initialization.F90 | 120 ++++++++++++++++------------- 1 file changed, 68 insertions(+), 52 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index ac586a02f6..bba357f490 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -48,19 +48,20 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: min_depth ! The minimum depth of the ocean [Z ~> m]. ! The following variables are used to set up the bathymetry in the ISOMIP example. - real :: bmax ! max depth of bedrock topography [Z ~> m] - real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] - real :: xbar ! characteristic along-flow length scale of the bedrock + real :: bmax ! maximum depth of bedrock topography [Z ~> m] + real :: b0, b2, b4, b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] + real :: xbar ! characteristic along-flow length scale of the bedrock [L ~> m] real :: dc ! depth of the trough compared with side walls [Z ~> m]. - real :: fc ! characteristic width of the side walls of the channel - real :: wc ! half-width of the trough - real :: ly ! domain width (across ice flow) - real :: bx, by ! dummy vatiables [Z ~> m]. - real :: xtil ! dummy vatiable - logical :: is_2D ! If true, use 2D setup -! This include declares and sets the variable "version". + real :: fc ! characteristic width of the side walls of the channel [L ~> m] + real :: wc ! half-width of the trough [L ~> m] + real :: ly ! domain width (across ice flow) [L ~> m] + real :: bx, by ! The x- and y- contributions to the bathymetric profiles at a point [Z ~> m] + real :: xtil ! x-positon normalized by the characteristic along-flow length scale [nondim] + real :: km_to_L ! The conversion factor from the axis units to L [L km-1 ~> 1e3] + logical :: is_2D ! If true, use a 2D setup + ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "ISOMIP_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed @@ -72,27 +73,39 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) - - ! The following variables should be transformed into runtime parameters? - bmax = 720.0*US%m_to_Z ; dc = 500.0*US%m_to_Z + call get_param(param_file, mdl, "ISOMIP_2D", is_2D, 'If true, use a 2D setup.', default=.false.) + call get_param(param_file, mdl, "ISOMIP_MAX_BEDROCK", bmax, & + "Maximum depth of bedrock topography in the ISOMIP configuration.", & + units="m", default=720.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "ISOMIP_TROUGH_DEPTH", dc, & + "Depth of the trough compared with side walls in the ISOMIP configuration.", & + units="m", default=500.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "ISOMIP_BEDROCK_LENGTH", xbar, & + "Characteristic along-flow length scale of the bedrock in the ISOMIP configuration.", & + units="m", default=300.0e3, scale=US%m_to_L) + call get_param(param_file, mdl, "ISOMIP_TROUGH_WIDTH", wc, & + "Half-width of the trough in the ISOMIP configuration.", & + units="m", default=24.0e3, scale=US%m_to_L) + call get_param(param_file, mdl, "ISOMIP_DOMAIN_WIDTH", ly, & + "Domain width (across ice flow) in the ISOMIP configuration.", & + units="m", default=80.0e3, scale=US%m_to_L) + call get_param(param_file, mdl, "ISOMIP_SIDE_WIDTH", fc, & + "Characteristic width of the side walls of the channel in the ISOMIP configuration.", & + units="m", default=4.0e3, scale=US%m_to_L) + + km_to_L = 1.0e3*US%m_to_L + + ! The following variables should be transformed into runtime parameters. b0 = -150.0*US%m_to_Z ; b2 = -728.8*US%m_to_Z ; b4 = 343.91*US%m_to_Z ; b6 = -50.57*US%m_to_Z - xbar = 300.0e3 ; fc = 4.0e3 ; wc = 24.0e3 ; ly = 80.0e3 - bx = 0.0 ; by = 0.0 ; xtil = 0.0 - if (is_2D) then do j=js,je ; do i=is,ie - ! 2D setup - xtil = G%geoLonT(i,j)*1.0e3/xbar - !xtil = 450*1.0e3/xbar + ! For the 2D setup take a slice through the middle of the domain + xtil = G%geoLonT(i,j)*km_to_L / xbar + !xtil = 450.*km_to_L / xbar bx = b0 + b2*xtil**2 + b4*xtil**4 + b6*xtil**6 - !by = (dc/(1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & - ! (dc/(1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) - ! slice at y = 40 km - by = (dc / (1.+exp(-2.*(40.0*1.0e3- ly/2. - wc)/fc))) + & - (dc / (1.+exp(2.*(40.0*1.0e3- ly/2. + wc)/fc))) + by = 2.0 * dc / (1.0 + exp(2.0*wc / fc)) D(i,j) = -max(bx+by, -bmax) if (D(i,j) > max_depth) D(i,j) = max_depth @@ -104,17 +117,17 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) ! 3D setup ! ===== TEST ===== !if (G%geoLonT(i,j)<500.) then - ! xtil = 500.*1.0e3/xbar + ! xtil = 500.*km_to_L / xbar !else - ! xtil = G%geoLonT(i,j)*1.0e3/xbar + ! xtil = G%geoLonT(i,j)*km_to_L / xbar !endif ! ===== TEST ===== - xtil = G%geoLonT(i,j)*1.0e3/xbar + xtil = G%geoLonT(i,j)*km_to_L / xbar bx = b0 + b2*xtil**2 + b4*xtil**4 + b6*xtil**6 - by = (dc / (1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & - (dc / (1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) + by = (dc / (1.0 + exp(-2.*(G%geoLatT(i,j)*km_to_L - 0.5*ly - wc) / fc))) + & + (dc / (1.0 + exp(2.*(G%geoLatT(i,j)*km_to_L - 0.5*ly + wc) / fc))) D(i,j) = -max(bx+by, -bmax) if (D(i,j) > max_depth) D(i,j) = max_depth @@ -264,17 +277,12 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables - integer :: i, j, k, is, ie, js, je, nz, itt real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: xi0, xi1 ! Heights in depth units [Z ~> m]. real :: S_sur, S_bot ! Salinity at the surface and bottom [S ~> ppt] real :: T_sur, T_bot ! Temperature at the surface and bottom [C ~> degC] real :: dT_dz ! Vertical gradient of temperature [C Z-1 ~> degC m-1]. real :: dS_dz ! Vertical gradient of salinity [S Z-1 ~> ppt m-1]. - !character(len=256) :: mesg ! The text of an error message - character(len=40) :: verticalCoordinate - !real :: rho_tmp - logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. real :: T0(SZK_(GV)) ! A profile of temperatures [C ~> degC] real :: S0(SZK_(GV)) ! A profile of salinities [S ~> ppt] real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. @@ -283,7 +291,14 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. (zero here) real :: drho_dT1 ! A prescribed derivative of density with temperature [R C-1 ~> kg m-3 degC-1] real :: drho_dS1 ! A prescribed derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. - real :: T_Ref, S_Ref + real :: T_ref ! Default value for other temperatures [C ~> degC] + real :: S_ref ! Default value for other salinities [S ~> ppt] + logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. + !real :: rho_tmp ! A temporary density used for debugging [R ~> kg m-3] + !character(len=256) :: mesg ! The text of an error message + character(len=40) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz, itt + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pres(:) = 0.0 @@ -343,8 +358,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U "A reference temperature used in initialization.", & units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, scale=US%ppt_to_S, do_not_log=just_read) + "A reference salinity used in initialization.", & + units="PSU", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 @@ -450,7 +465,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, real :: TNUDG ! Nudging time scale [T ~> s] real :: S_sur, S_bot ! Surface and bottom salinities in the sponge region [S ~> ppt] real :: T_sur, T_bot ! Surface and bottom temperatures in the sponge region [C ~> degC] - real :: t_ref, s_ref ! reference (default) T [degC] and S [ppt] + real :: T_ref ! Default value for other temperatures [C ~> degC] + real :: S_ref ! Default value for other salinities [S ~> ppt] real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: rho_range ! The range of densities [R ~> kg m-3] real :: dT_dz ! Vertical gradient of temperature [C Z-1 ~> degC m-1] @@ -460,9 +476,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m]. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. - real :: min_depth, dummy1 - real :: min_thickness, xi0 - !real :: rho_tmp + real :: min_depth ! The minimum depth of the ocean [Z ~> m] + real :: min_thickness ! The minimum layer thickness [Z ~> m] + real :: xi0 ! Interface heights in depth units [Z ~> m], usually negative. + !real :: rho_tmp ! A temporary density used for debugging [R ~> kg m-3] character(len=40) :: verticalCoordinate, filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir @@ -481,27 +498,27 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, "Nudging time scale for sponge layers", & units="days", default=0.0, scale=86400.0*US%s_to_T) - call get_param(PF, mdl, "T_REF", t_ref, "Reference temperature", & - units="degC", default=10.0, scale=1.0, do_not_log=.true.) + call get_param(PF, mdl, "T_REF", T_ref, "Reference temperature", & + units="degC", default=10.0, scale=US%degC_to_C, do_not_log=.true.) call get_param(PF, mdl, "S_REF", s_ref, "Reference salinity", & - units="ppt", default=35.0, scale=1.0, do_not_log=.true.) + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, & "Surface salinity in sponge layer.", & - units="ppt", default=s_ref, scale=US%ppt_to_S) + units="ppt", default=US%S_to_ppt*S_ref, scale=US%ppt_to_S) call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, & "Bottom salinity in sponge layer.", & - units="ppt", default=s_ref, scale=US%ppt_to_S) + units="ppt", default=US%S_to_ppt*S_ref, scale=US%ppt_to_S) call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, & "Surface temperature in sponge layer.", & - units="degC", default=t_ref, scale=US%degC_to_C) + units="degC", default=US%C_to_degC*T_ref, scale=US%degC_to_C) call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, & "Bottom temperature in sponge layer.", & - units="degC", default=t_ref, scale=US%degC_to_C) + units="degC", default=US%C_to_degC*T_ref, scale=US%degC_to_C) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 !; RHO(:,:,:) = 0.0 @@ -523,8 +540,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, if (depth_tot(i,j) <= min_depth) then Idamp(i,j) = 0.0 elseif (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - dummy1 = (G%geoLonT(i,j)-790.0)/(800.0-790.0) - Idamp(i,j) = (1.0/TNUDG) * max(0.0,dummy1) + Idamp(i,j) = (1.0/TNUDG) * max(0.0, (G%geoLonT(i,j)-790.0) / (800.0-790.0)) else Idamp(i,j) = 0.0 endif From 12fba70abfe7e8d4f7c3b93e6f3d064fbe74b15c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:28:34 -0500 Subject: [PATCH 072/213] +Standard seamount_initialization axis unit docs Standardized documentation of axis-related variable units and applied dimensional scaling factors to parameters that are read in for use as defaults for other variables in seamount_initialization, including using the new G%x_ax_unit_short elements to automatically write the AXIS_UNITS-dependent units into the MOM_parameter_doc files. Also added comments describing the internal variables in the same module. All answers are bitwise identical but there are minor changes in some MOM_parameter_doc files. --- src/user/seamount_initialization.F90 | 45 +++++++++++++++------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index dd2e50fcae..a1f978a784 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -40,25 +40,28 @@ module seamount_initialization subroutine seamount_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables + real :: delta ! Height of the seamount as a fraction of the maximum ocean depth [nondim] + real :: x, y ! Normalized positions relative to the domain center [nondim] + real :: Lx, Ly ! Seamount length scales normalized by the relevant domain sizes [nondim] + real :: rLx, rLy ! The Adcroft reciprocals of Lx and Ly [nondim] integer :: i, j - real :: x, y, delta, Lx, rLx, Ly, rLy - call get_param(param_file, mdl,"SEAMOUNT_DELTA",delta, & + call get_param(param_file, mdl,"SEAMOUNT_DELTA", delta, & "Non-dimensional height of seamount.", & - units="non-dim", default=0.5) - call get_param(param_file, mdl,"SEAMOUNT_X_LENGTH_SCALE",Lx, & + units="nondim", default=0.5) + call get_param(param_file, mdl,"SEAMOUNT_X_LENGTH_SCALE", Lx, & "Length scale of seamount in x-direction. "//& "Set to zero make topography uniform in the x-direction.", & - units="Same as x,y", default=20.) - call get_param(param_file, mdl,"SEAMOUNT_Y_LENGTH_SCALE",Ly, & + units=G%x_ax_unit_short, default=20.) + call get_param(param_file, mdl,"SEAMOUNT_Y_LENGTH_SCALE", Ly, & "Length scale of seamount in y-direction. "//& "Set to zero make topography uniform in the y-direction.", & - units="Same as x,y", default=0.) + units=G%y_ax_unit_short, default=0.) Lx = Lx / G%len_lon Ly = Ly / G%len_lat @@ -93,7 +96,7 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_ref ! A default value for salinities [ppt]. + real :: S_ref ! A default value for salinities [S ~> ppt]. real :: S_surf, S_range, S_light, S_dense ! Various salinities [S ~> ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. character(len=20) :: verticalCoordinate @@ -129,11 +132,11 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, & units="ppt", default=2., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, & - units="ppt", default=35.0, scale=1.0, do_not_log=.true.) + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="ppt", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="ppt", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & @@ -208,8 +211,8 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi ! Local variables real :: xi0, xi1 ! Fractional positions within the depth range [nondim] real :: r ! A nondimensional sharpness parameter with an exponetial profile [nondim] - real :: S_Ref ! Default salinity range parameters [ppt]. - real :: T_Ref ! Default temperature range parameters [degC]. + real :: S_Ref ! Default salinity range parameters [S ~> ppt]. + real :: T_Ref ! Default temperature range parameters [C ~> degC]. real :: S_Light, S_Dense, S_surf, S_range ! Salinity range parameters [S ~> ppt]. real :: T_Light, T_Dense, T_surf, T_range ! Temperature range parameters [C ~> degC]. real :: res_rat ! The ratio of density space resolution in the denser part @@ -245,17 +248,17 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi case ( REGRIDDING_LAYER ) ! Initial thicknesses for layer isopycnal coordinates ! These parameters are used in MOM_fixed_initialization.F90 when CONFIG_COORD="ts_range" call get_param(param_file, mdl, "T_REF", T_ref, & - units="degC", default=10.0, do_not_log=.true.) + units="degC", default=10.0, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_light, & - units="degC", default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_dense, & - units="degC", default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, & - units="1e-3", default=35.0, scale=1.0, do_not_log=.true.) + units="1e-3", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - units="1e-3", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="1e-3", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - units="1e-3", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="1e-3", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & units="nondim", default=1.0, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. From 595c8b0ec3e704766f7a1b37f3177c5ac0a2cf5a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:28:57 -0500 Subject: [PATCH 073/213] +Document units in Neverworld_initialization Added units arguments to 2 get_param calls in Neverworld_initialization. This commit also adds comments describing many internal real variables and their units in this same module. All answers and output are bitwise identical, but there are minor changes in the MOM_parameter_doc files. --- src/user/Neverworld_initialization.F90 | 42 +++++++++++++++----------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 0ba2cbba01..fcd40cf8da 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -40,12 +40,13 @@ subroutine Neverworld_initialize_topography(D, G, param_file, max_depth) ! Local variables real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: x, y + real :: x, y ! Lateral positions normalized by the domain size [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "Neverworld_initialize_topography" ! This subroutine's name. + real :: nl_top_amp ! Amplitude of large-scale topographic features as a fraction of the maximum depth [nondim] + real :: nl_roughness_amp ! Amplitude of topographic roughness as a fraction of the maximum depth [nondim] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - real :: nl_roughness_amp, nl_top_amp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -53,16 +54,16 @@ subroutine Neverworld_initialize_topography(D, G, param_file, max_depth) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "NL_ROUGHNESS_AMP", nl_roughness_amp, & - "Amplitude of wavy signal in bathymetry.", default=0.05) + "Amplitude of wavy signal in bathymetry.", units="nondim", default=0.05) call get_param(param_file, mdl, "NL_CONTINENT_AMP", nl_top_amp, & - "Scale factor for topography - 0.0 for no continents.", default=1.0) + "Scale factor for topography - 0.0 for no continents.", units="nondim", default=1.0) PI = 4.0*atan(1.0) ! Calculate the depth of the bottom. do j=js,je ; do i=is,ie x = (G%geoLonT(i,j)-G%west_lon) / G%len_lon - y =( G%geoLatT(i,j)-G%south_lat) / G%len_lat + y = (G%geoLatT(i,j)-G%south_lat) / G%len_lat ! This sets topography that has a reentrant channel to the south. D(i,j) = 1.0 - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) - & !< The great northern wall and Antarctica nl_top_amp*( & @@ -83,8 +84,8 @@ end subroutine Neverworld_initialize_topography !> Returns the value of a cosine-bell function evaluated at x/L real function cosbell(x, L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width + real , intent(in) :: x !< non-dimensional position [nondim] + real , intent(in) :: L !< non-dimensional width [nondim] real :: PI !< 3.1415926... calculated as 4*atan(1) PI = 4.0*atan(1.0) @@ -94,8 +95,8 @@ end function cosbell !> Returns the value of a sin-spike function evaluated at x/L real function spike(x, L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width + real , intent(in) :: x !< non-dimensional position [nondim] + real , intent(in) :: L !< non-dimensional width [nondim] real :: PI !< 3.1415926... calculated as 4*atan(1) PI = 4.0*atan(1.0) @@ -127,6 +128,8 @@ real function scurve(x, x0, L) scurve = ( 3. - 2.*s ) * ( s * s ) end function scurve +! None of the following 7 functions appear to be used. + !> Returns a "coastal" profile. real function cstprof(x, x0, L, lf, bf, sf, sh) real, intent(in) :: x !< non-dimensional coordinate [nondim] @@ -228,7 +231,7 @@ real function circ_ridge(lon, lat, lon0, lat0, ring_radius, ring_thickness, ridg r = sqrt( (lon - lon0)**2 + (lat - lat0)**2 ) ! Pseudo-distance from a point r = abs( r - ring_radius) ! Pseudo-distance from a circle r = cone(r, 0., ring_thickness, ridge_height) ! 0 .. frac_ridge_height - circ_ridge = 1. - r ! nondim depths (1-frac_ridge_height) .. 1 + circ_ridge = 1. - r ! Fractional depths (1-frac_ridge_height) .. 1 end function circ_ridge !> This subroutine initializes layer thicknesses for the Neverworld test case, @@ -253,10 +256,13 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, ! usually negative because it is positive upward. real, dimension(SZK_(GV)) :: h_profile ! Vector of initial thickness profile [Z ~> m]. real :: e_interface ! Current interface position [Z ~> m]. - real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. - real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H - real :: h_noise ! Amplitude of noise to scale h by - real :: noise ! Noise + real :: x, y ! horizontal coordinates for computation of the initial perturbation normalized + ! by the domain sizes [nondim] + real :: r1, r2 ! radial coordinates for computation of initial perturbation, normalized + ! by the domain sizes [nondim] + real :: pert_amp ! Amplitude of perturbations as a fraction of layer thicknesses [nondim] + real :: h_noise ! Amplitude of noise to scale h by [nondim] + real :: noise ! Fractional noise in the layer thicknesses [nondim] type(randomNumberStream) :: rns ! Random numbers for stochastic tidal parameterization character(len=40) :: mdl = "Neverworld_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -283,10 +289,10 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, e_interface = -depth_tot(i,j) do k=nz,2,-1 h(i,j,k) = GV%Z_to_H * (e0(k) - e_interface) ! Nominal thickness - x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat - r1=sqrt((x-0.7)**2+(y-0.2)**2) - r2=sqrt((x-0.3)**2+(y-0.25)**2) + x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon + y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat + r1 = sqrt((x-0.7)**2+(y-0.2)**2) + r2 = sqrt((x-0.3)**2+(y-0.25)**2) h(i,j,k) = h(i,j,k) + pert_amp * (e0(k) - e0(nz+1)) * GV%Z_to_H * & (spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation if (h_noise /= 0.) then From 17def80b7c816a4309e9ff80008c1f2b535554fc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:29:23 -0500 Subject: [PATCH 074/213] +Document units in RGC_initialization & RGC_tracer Added units arguments to 3 get_param calls in the two RGC modules. Also use elements of the ocean_grid_type to specify the units of some horizontal position related variables and to determine the domain size, rather than using separate get_param calls for LENLAT or LENLAT. This commit also adds comments describing many internal real variables and their units in RGC_tracer.F90. All answers and output are bitwise identical, but there are minor changes in the MOM_parameter_doc files for cases that use the RGC routines. --- src/tracer/RGC_tracer.F90 | 56 ++++++++++++++------------------- src/user/RGC_initialization.F90 | 19 +++-------- 2 files changed, 28 insertions(+), 47 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 9ceadc602d..7c9b52b66e 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -47,13 +47,11 @@ module RGC_tracer character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry. - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package. - real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration. - real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. - real :: lenlat !< the latitudinal or y-direction length of the domain. - real :: lenlon !< the longitudinal or x-direction length of the domain. - real :: CSL !< The length of the continental shelf (x dir, km) - real :: lensponge !< the length of the sponge layer. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package [kg kg-1] + real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration [kg kg-1] + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out [kg kg-1] + real :: CSL !< The length of the continental shelf (x direction) [km] + real :: lensponge !< the length of the sponge layer [km] logical :: mask_tracers !< If true, tracers are masked out in massless layers. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. @@ -72,14 +70,14 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(RGC_tracer_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure character(len=80) :: name, longname ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "RGC_tracer" ! This module's name. character(len=200) :: inputdir - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers in this module [kg kg-1] logical :: register_RGC_tracer integer :: isd, ied, jsd, jed, nz, m isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -108,21 +106,15 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) - call get_param(param_file, mdl, "LENLAT", CS%lenlat, & - "The latitudinal or y-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - - call get_param(param_file, mdl, "LENLON", CS%lenlon, & - "The longitudinal or x-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - call get_param(param_file, mdl, "CONT_SHELF_LENGTH", CS%CSL, & "The length of the continental shelf (x dir, km).", & - default=15.0) + units="km", default=15.0) + ! units=G%x_ax_unit_short, default=15.0) call get_param(param_file, mdl, "LENSPONGE", CS%lensponge, & "The length of the sponge layer (km).", & - default=10.0) + units="km", default=10.0) + ! units=G%x_ax_unit_short, default=10.0) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) if (CS%mask_tracers) then @@ -153,13 +145,13 @@ end function register_RGC_tracer subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & layer_CSp, sponge_CSp) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary @@ -170,9 +162,9 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the !! sponges, if they are in use. Otherwise this may be unassociated. - real, allocatable :: temp(:,:,:) + real, allocatable :: temp(:,:,:) ! A temporary array used for several sponge target values [various] character(len=16) :: name ! A variable's name in a NetCDF file. - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers in this module [kg kg-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m @@ -224,7 +216,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (nzdata>0) then allocate(temp(G%isd:G%ied,G%jsd:G%jed,nzdata)) do k=1,nzdata ; do j=js,je ; do i=is,ie - if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + if (G%geoLonT(i,j) >= (G%len_lon - CS%lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then temp(i,j,k) = 0.0 endif enddo ; enddo ; enddo @@ -240,7 +232,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (nz>0) then allocate(temp(G%isd:G%ied,G%jsd:G%jed,nz)) do k=1,nz ; do j=js,je ; do i=is,ie - if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + if (G%geoLonT(i,j) >= (G%len_lon - CS%lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then temp(i,j,k) = 0.0 endif enddo ; enddo ; enddo @@ -263,8 +255,8 @@ end subroutine initialize_RGC_tracer !! This is a simple example of a set of advected passive tracers. subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -283,22 +275,20 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be - !! fluxed out of the top layer in a timestep [nondim]. + !! fluxed out of the top layer in a timestep [nondim]. real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes - !! can be applied [H ~> m or kg m-2]. + !! can be applied [H ~> m or kg m-2]. ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real :: in_flux(SZI_(G),SZJ_(G),2) ! total amount of tracer to be injected integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return - in_flux(:,:,:) = 0.0 m=1 do j=js,je ; do i=is,ie ! set tracer to 1.0 in the surface of the continental shelf @@ -313,7 +303,7 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo; call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & - evap_CFL_limit, minimum_forcing_depth, in_flux(:,:,m)) + evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) enddo diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index b56e0b895a..e918342d42 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -45,7 +45,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C !! to any available thermodynamic !! fields, potential temperature and !! salinity or mixed layer density. - !! Absent fields have NULL ptrs. + !! Absent fields have NULL pointers. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -72,7 +72,6 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C real :: min_depth ! The minimum depth of the ocean [Z ~> m] real :: dummy1 ! The position relative to the sponge width [nondim] real :: min_thickness ! A minimum layer thickness [H ~> m or kg m-2] (unused) - real :: lenlat, lenlon ! The sizes of the domain [km] real :: lensponge ! The width of the sponge [km] character(len=40) :: filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir, h_var @@ -92,17 +91,9 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C call get_param(PF, mdl, "RGC_TNUDG", TNUDG, 'Nudging time scale for sponge layers', & units='days', default=0.0, scale=86400.0*US%s_to_T) - call get_param(PF, mdl, "LENLAT", lenlat, & - "The latitudinal or y-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - - call get_param(PF, mdl, "LENLON", lenlon, & - "The longitudinal or x-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - call get_param(PF, mdl, "LENSPONGE", lensponge, & - "The length of the sponge layer (km).", & - default=10.0) + "The length of the sponge layer.", & + units=G%x_ax_unit_short, default=10.0) call get_param(PF, mdl, "SPONGE_UV", sponge_uv, & "Nudge velocities (u and v) towards zero in the sponge layer.", & @@ -126,8 +117,8 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C do i=is,ie ; do j=js,je if ((depth_tot(i,j) <= min_depth) .or. (G%geoLonT(i,j) <= lensponge)) then Idamp(i,j) = 0.0 - elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then - dummy1 = (G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) + elseif (G%geoLonT(i,j) >= (G%len_lon - lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then + dummy1 = (G%geoLonT(i,j)-(G%len_lon - lensponge))/(lensponge) Idamp(i,j) = (1.0/TNUDG) * max(0.0,dummy1) else Idamp(i,j) = 0.0 From 1b00485a2655d49492a1017a8f348d5f56684a07 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:29:58 -0500 Subject: [PATCH 075/213] +Document units in adjustment_initialization Add units arguments to 3 get_param calls and modified them in 4 others in adjustment_initialization, using elements of the ocean_grid_type to specify the units of some horizontal position related variables. This commit also adds comments describing many internal real variables and their units in this same file. All answers and output are bitwise identical, but there are minor changes in the MOM_parameter_doc files. --- src/user/adjustment_initialization.F90 | 147 +++++++++++++------------ 1 file changed, 79 insertions(+), 68 deletions(-) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 3509ef69d3..92a7faf29e 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -46,18 +46,23 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. - ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. - real :: x, y, yy - real :: S_ref ! Reference salinity within surface layer [S ~> ppt] - real :: S_range ! Range of salinities in the vertical [S ~> ppt] - real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] - real :: delta_S ! The local salinity perturbation [S ~> ppt] - real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] - real :: min_thickness, adjustment_width, adjustment_delta - real :: adjustment_deltaS - real :: front_wave_amp, front_wave_length, front_wave_asym - real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] + real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. + ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. + real :: x, y, yy ! Fractional positions in the x- and y-directions [nondim] + real :: y_lat ! y-positions in the units of latitude [m] or [km] or [degrees] + real :: S_ref ! Reference salinity within surface layer [S ~> ppt] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] + real :: delta_S ! The local salinity perturbation [S ~> ppt] + real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] + real :: min_thickness ! The minimum layer thickness [Z ~> m] + real :: adjustment_delta ! Interface height anomalies, positive downward [Z ~> m] + real :: adjustment_width ! Width of the frontal zone [m] or [km] or [degrees] + real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] + real :: front_wave_amp ! Amplitude of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_length ! Wave-length of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_asym ! Amplitude of frontal asymmetric perturbation [m] or [km] or [degrees] + real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] character(len=20) :: verticalCoordinate ! This include declares and sets the variable "version". # include "version_variable.h" @@ -72,30 +77,30 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & + call get_param(param_file, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & default=1.0e-3, units='m', scale=US%m_to_Z, do_not_log=just_read) ! Parameters specific to this experiment configuration - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) - call get_param(param_file, mdl,"ADJUSTMENT_WIDTH",adjustment_width, & + call get_param(param_file, mdl, "ADJUSTMENT_WIDTH", adjustment_width, & "Width of frontal zone", & - units="same as x,y", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"DELTA_S_STRAT",delta_S_strat, & + units=G%x_ax_unit_short, fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "DELTA_S_STRAT", delta_S_strat, & "Top-to-bottom salinity difference of stratification", & units="1e-3", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"ADJUSTMENT_DELTAS",adjustment_deltaS, & + call get_param(param_file, mdl, "ADJUSTMENT_DELTAS", adjustment_deltaS, & "Salinity difference across front", & units="1e-3", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"FRONT_WAVE_AMP",front_wave_amp, & + call get_param(param_file, mdl, "FRONT_WAVE_AMP", front_wave_amp, & "Amplitude of trans-frontal wave perturbation", & - units="same as x,y", default=0., do_not_log=just_read) - call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & + units=G%x_ax_unit_short, default=0., do_not_log=just_read) + call get_param(param_file, mdl, "FRONT_WAVE_LENGTH", front_wave_length, & "Wave-length of trans-frontal wave perturbation", & - units="same as x,y", default=0., do_not_log=just_read) - call get_param(param_file, mdl,"FRONT_WAVE_ASYM",front_wave_asym, & + units=G%x_ax_unit_short, default=0., do_not_log=just_read) + call get_param(param_file, mdl, "FRONT_WAVE_ASYM", front_wave_asym, & "Amplitude of frontal asymmetric perturbation", & - units="same as x,y", default=0., do_not_log=just_read) + units=G%x_ax_unit_short, default=0., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -142,11 +147,11 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read yy = 2. * ( G%geoLatT(i,j) - 0.5 * G%len_lat ) / adjustment_width yy = min(1.0, yy); yy = max(-1.0, yy) yy = yy * 2. * acos( 0. ) - y = front_wave_amp*sin(y) + front_wave_asym*sin(yy) + y_lat = front_wave_amp*sin(y) + front_wave_asym*sin(yy) else - y = 0. + y_lat = 0. endif - x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y ) / adjustment_width + x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y_lat ) / adjustment_width x = min(1.0, x); x = max(-1.0, x) x = x * acos( 0. ) delta_S = adjustment_deltaS * 0.5 * (1. - sin( x ) ) @@ -185,7 +190,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read enddo ; enddo case default - call MOM_error(FATAL,"adjustment_initialize_thickness: "// & + call MOM_error(FATAL, "adjustment_initialize_thickness: "// & "Unrecognized i.c. setup - set ADJUSTMENT_IC") end select @@ -197,57 +202,63 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: T !< The temperature that is being initialized [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: S !< The salinity that is being initialized [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to - !! parse for model parameter values. - logical, intent(in) :: just_read !< If true, this call will only read - !! parameters without changing T & S. - - integer :: i, j, k, is, ie, js, je, nz - real :: x, y, yy - real :: S_ref ! Reference salinity within surface layer [S ~> ppt] - real :: T_ref ! Reference temperature within surface layer [C ~> degC] - real :: S_range ! Range of salinities in the vertical [S ~> ppt] - real :: T_range ! Range of temperatures in the vertical [C ~> degC] - real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] - real :: delta_S ! The local salinity perturbation [S ~> ppt] - real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] - real :: adjustment_width - real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] - real :: front_wave_amp, front_wave_length, front_wave_asym - real :: eta1d(SZK_(GV)+1) ! Interface heights [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. + + real :: x, y, yy ! Fractional positions in the x- and y-directions [nondim] + real :: y_lat ! y-position in the units of latitude [m] or [km] or [degrees] + real :: S_ref ! Reference salinity within surface layer [S ~> ppt] + real :: T_ref ! Reference temperature within surface layer [C ~> degC] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: T_range ! Range of temperatures in the vertical [C ~> degC] + real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] + real :: delta_S ! The local salinity perturbation [S ~> ppt] + real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] + real :: adjustment_width ! Width of the frontal zone [m] or [km] or [degrees] + real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] + real :: front_wave_amp ! Amplitude of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_length ! Wave-length of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_asym ! Amplitude of frontal asymmetric perturbation [m] or [km] or [degrees] + real :: eta1d(SZK_(GV)+1) ! Interface heights [Z ~> m] character(len=20) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Parameters used by main model initialization call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"S_RANGE", S_range, 'Initial salinity range', & + call get_param(param_file, mdl, "S_RANGE", S_range, 'Initial salinity range', & default=2.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & default=0.0, units='C', scale=US%degC_to_C, do_not_log=just_read) ! Parameters specific to this experiment configuration BUT logged in previous s/r - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) - call get_param(param_file, mdl,"ADJUSTMENT_WIDTH", adjustment_width, & - fail_if_missing=.not.just_read, do_not_log=.true.) - call get_param(param_file, mdl,"ADJUSTMENT_DELTAS", adjustment_deltaS, & + call get_param(param_file, mdl, "ADJUSTMENT_WIDTH", adjustment_width, & + units=G%x_ax_unit_short, fail_if_missing=.not.just_read, do_not_log=.true.) + call get_param(param_file, mdl, "ADJUSTMENT_DELTAS", adjustment_deltaS, & units='1e-3', scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=.true.) - call get_param(param_file, mdl,"DELTA_S_STRAT", delta_S_strat, & + call get_param(param_file, mdl, "DELTA_S_STRAT", delta_S_strat, & units='1e-3', scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=.true.) - call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & - do_not_log=.true.) - call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & - default=0., do_not_log=.true.) - call get_param(param_file, mdl,"FRONT_WAVE_ASYM", front_wave_asym, default=0., & - do_not_log=.true.) + call get_param(param_file, mdl, "FRONT_WAVE_AMP", front_wave_amp, & + units=G%x_ax_unit_short, default=0., do_not_log=.true.) + call get_param(param_file, mdl, "FRONT_WAVE_LENGTH", front_wave_length, & + units=G%x_ax_unit_short, default=0., do_not_log=.true.) + call get_param(param_file, mdl, "FRONT_WAVE_ASYM", front_wave_asym, & + units=G%x_ax_unit_short, default=0., do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -269,11 +280,11 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, yy = 2. * ( G%geoLatT(i,j) - 0.5 * G%len_lat ) / front_wave_length yy = min(1.0, yy); yy = max(-1.0, yy) yy = yy * 2. * acos( 0. ) - y = front_wave_amp*sin(y) + front_wave_asym*sin(yy) + y_lat = front_wave_amp*sin(y) + front_wave_asym*sin(yy) else - y = 0. + y_lat = 0. endif - x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y ) / adjustment_width + x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y_lat ) / adjustment_width x = min(1.0, x); x = max(-1.0, x) x = x * acos( 0. ) delta_S = adjustment_deltaS * 0.5 * (1. - sin( x ) ) @@ -296,7 +307,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, enddo case default - call MOM_error(FATAL,"adjustment_initialize_temperature_salinity: "// & + call MOM_error(FATAL, "adjustment_initialize_temperature_salinity: "// & "Unrecognized i.c. setup - set ADJUSTMENT_IC") end select From 09d2adfdeeebf4aa6c145ddc527b6aba7f2b25c6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:30:31 -0500 Subject: [PATCH 076/213] +Rescale default salinity in dumbbell_initialization Added an argument documenting the units of S_REF and another rescaling it in dumbbell_initialize_thickness. The units of several other arguments or internal variables in this same file were also described in revised comments. All answers and output are bitwise identical. --- src/user/dumbbell_initialization.F90 | 54 +++++++++++++++------------- 1 file changed, 30 insertions(+), 24 deletions(-) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 90d745004b..26b382b94c 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -41,18 +41,21 @@ module dumbbell_initialization subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables - integer :: i, j - real :: x, y, dblen, dbfrac - logical :: dbrotate + real :: x, y ! Fractional x- and y- positions [nondim] + real :: dblen ! Lateral length scale for dumbbell [km] or [m] + real :: dbfrac ! Meridional fraction for narrow part of dumbbell [nondim] + logical :: dbrotate ! If true, rotate this configuration + integer :: i, j call get_param(param_file, mdl, "DUMBBELL_LEN",dblen, & 'Lateral Length scale for dumbbell.', & units='km', default=600., do_not_log=.false.) + ! units=G%x_ax_unit_short, default=600., do_not_log=.false.) call get_param(param_file, mdl, "DUMBBELL_FRACTION",dbfrac, & 'Meridional fraction for narrow part of dumbbell.', & units='nondim', default=0.5, do_not_log=.false.) @@ -60,8 +63,8 @@ subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) 'Logical for rotation of dumbbell domain.', & default=.false., do_not_log=.false.) - if (G%x_axis_units == 'm') then - dblen=dblen*1.e3 + if (G%x_axis_units(1:1) == 'm') then + dblen = dblen*1.e3 endif if (dbrotate) then @@ -107,11 +110,12 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_ref ! A default value for salinities [ppt]. + real :: S_ref ! A default value for salinities [S ~> ppt]. real :: S_surf ! The surface salinity [S ~> ppt] real :: S_range ! The range of salinities in this test case [S ~> ppt] real :: S_light, S_dense ! The lightest and densest salinities in the sponges [S ~> ppt]. - real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. + real :: eta_IC_quanta ! The granularity of quantization of initial interface heights [Z-1 ~> m-1]. + real :: x ! Along-channel position in the axis units [m] or [km] or [deg] logical :: dbrotate ! If true, rotate the domain. logical :: use_ALE ! True if ALE is being used, False if in layered mode @@ -119,7 +123,6 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, # include "version_variable.h" character(len=20) :: verticalCoordinate integer :: i, j, k, is, ie, js, je, nz - real :: x, y is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -153,7 +156,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, default=.false., do_not_log=just_read) do j=js,je do i=is,ie - ! Compute normalized zonal coordinates (x,y=0 at center of domain) + ! Compute normalized zonal coordinates (x,y=0 at center of domain) if (dbrotate) then ! This is really y in the rotated case x = G%geoLatT(i,j) @@ -174,18 +177,20 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, do k=1,nz h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) enddo - enddo; enddo + enddo + enddo case ( REGRIDDING_RHO, REGRIDDING_HYCOM1) ! Initial thicknesses for isopycnal coordinates call get_param(param_file, mdl, "INITIAL_SSS", S_surf, & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INITIAL_S_RANGE", S_range, & units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - units='1e-3', default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units='1e-3', default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - units='1e-3', default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units='1e-3', default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & @@ -263,9 +268,9 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ real :: S_range ! The range of salinities in this test case [S ~> ppt] real :: T_surf ! The surface temperature [C ~> degC] real :: x ! The fractional position in the domain [nondim] - real :: dblen ! The size of the dumbbell test case [axis_units] + real :: dblen ! The size of the dumbbell test case [km] or [m] logical :: dbrotate ! If true, rotate the domain. - logical :: use_ALE ! If false, use layer mode. + logical :: use_ALE ! If false, use layer mode. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -291,11 +296,12 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ call get_param(param_file, mdl, "DUMBBELL_LEN", dblen, & 'Lateral Length scale for dumbbell ', & units='km', default=600., do_not_log=just_read) + ! units=G%x_ax_unit_short, default=600., do_not_log=.false.) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & default=.false., do_not_log=just_read) - if (G%x_axis_units == 'm') then + if (G%x_axis_units(1:1) == 'm') then dblen = dblen*1.e3 endif @@ -346,12 +352,12 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinities [S ~> ppt] - real, dimension(SZK_(GV)+1) :: eta1D ! interface positions for ALE sponge + real, dimension(SZK_(GV)+1) :: eta1D ! Interface positions for ALE sponge [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! A temporary array for interface heights [Z ~> m]. integer :: i, j, k, nz real :: x ! The fractional position in the domain [nondim] - real :: dblen ! The size of the dumbbell test case [axis_units] + real :: dblen ! The size of the dumbbell test case [km] or [m] real :: min_thickness ! The minimum layer thickness [Z ~> m] real :: S_ref, S_range ! A reference salinity and the range of salinities in this test case [S ~> ppt] logical :: dbrotate ! If true, rotate the domain. @@ -363,8 +369,8 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil 'Logical for rotation of dumbbell domain.', & default=.false., do_not_log=.true.) - if (G%x_axis_units == 'm') then - dblen=dblen*1.e3 + if (G%x_axis_units(1:1) == 'm') then + dblen = dblen*1.e3 endif nz = GV%ke @@ -448,7 +454,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil enddo ; enddo if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & sp_long_name='salinity', sp_unit='g kg-1 s-1') - else + else do j=G%jsc,G%jec ; do i=G%isc,G%iec eta(i,j,1) = 0.0 do k=2,nz @@ -466,7 +472,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%S) ) call set_up_sponge_field(S, tv%S, G, GV, nz, CSp) - endif + endif end subroutine dumbbell_initialize_sponges From e306cbb88211eb420acd1fdd07521785a2b65aed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:31:25 -0500 Subject: [PATCH 077/213] +Document variable units in shelfwave_initialization Added or modified units arguments for 4 get_param calls in shelfwave_initialization, although until a full grid_type is provided to the various register OBC calls, the axis units will have to be hard-coded rather than using the fields from the grid_type. Also added or revised comments documenting various internal or control structure variables and their units. All answers and output are bitwise identical, but there are minor changes in the MOM_parameter_doc files. --- src/user/shelfwave_initialization.F90 | 47 ++++++++++++++++----------- 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index a9c1914356..7d588c49a0 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -31,10 +31,10 @@ module shelfwave_initialization real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] real :: Ly = 50.0 !< Cross-shore length scale [km] real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] - real :: jj = 1 !< Cross-shore wave mode. - real :: kk !< Parameter. - real :: ll !< Longshore wavenumber. - real :: alpha !< 1/Ly. + real :: jj = 1.0 !< Cross-shore wave mode [nondim] + real :: kk !< Cross-shore wavenumber [km-1] + real :: ll !< Longshore wavenumber [km-1] + real :: alpha !< Exponential decay rate in the y-direction [km-1] real :: omega !< Frequency of the shelf wave [T-1 ~> s-1] end type shelfwave_OBC_CS @@ -45,10 +45,11 @@ function register_shelfwave_OBC(param_file, CS, US, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(shelfwave_OBC_CS), pointer :: CS !< shelfwave control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. + type(OBC_registry_type), pointer :: OBC_Reg !< Open boundary condition registry. logical :: register_shelfwave_OBC ! Local variables - real :: PI, len_lat + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: len_lat ! Y-direction size of the domain [km] character(len=32) :: casename = "shelfwave" !< This case's name. @@ -61,21 +62,24 @@ function register_shelfwave_OBC(param_file, CS, US, OBC_Reg) endif allocate(CS) + !### Revise these parameters once the ocean_grid_type is available. + ! Register the tracer for horizontal advection & diffusion. call register_OBC(casename, param_file, OBC_Reg) call get_param(param_file, mdl, "F_0", CS%f0, & default=0.0, units="s-1", scale=US%T_to_s, do_not_log=.true.) call get_param(param_file, mdl, "LENLAT", len_lat, & - do_not_log=.true., fail_if_missing=.true.) - call get_param(param_file, mdl,"SHELFWAVE_X_WAVELENGTH",CS%Lx, & + units="km", do_not_log=.true., fail_if_missing=.true.) + call get_param(param_file, mdl,"SHELFWAVE_X_WAVELENGTH", CS%Lx, & "Length scale of shelfwave in x-direction.",& - units="Same as x,y", default=100.) + units="km", default=100.) ! units="km", default=100.0, scale=1.0e3*US%m_to_L) + ! units=G%x_ax_unit_short, default=100.) call get_param(param_file, mdl, "SHELFWAVE_Y_LENGTH_SCALE", CS%Ly, & - "Length scale of exponential dropoff of topography "//& - "in the y-direction.", & - units="Same as x,y", default=50.) + "Length scale of exponential dropoff of topography in the y-direction.", & + units="km", default=50.) ! units="km", default=50.0, scale=1.0e3*US%m_to_L) + ! units=G%y_ax_unit_short, default=50.) call get_param(param_file, mdl, "SHELFWAVE_Y_MODE", CS%jj, & "Cross-shore wave mode.", & units="nondim", default=1.) @@ -107,11 +111,14 @@ subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables + real :: y ! Position relative to the southern boundary [km] or [degrees_N] + real :: rLy ! Exponential decay rate of the topography [km-1] or [degrees_N-1] + real :: Ly ! Exponential decay lengthscale of the topography [km] or [degrees_N] + real :: H0 ! The minimum depth of the ocean [Z ~> m] integer :: i, j - real :: y, rLy, Ly, H0 - call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & - default=50., do_not_log=.true.) + call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE", Ly, & + units=G%y_ax_unit_short, default=50., do_not_log=.true.) call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & default=10., units="m", scale=US%m_to_Z, do_not_log=.true.) @@ -140,10 +147,13 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) ! The following variables are used to set up the transport in the shelfwave example. real :: my_amp ! Amplitude of the open boundary current inflows [L T-1 ~> m s-1] real :: time_sec ! The time in the run [T ~> s] - real :: cos_wt, cos_ky, sin_wt, sin_ky + real :: cos_wt, sin_wt ! Cosine and sine associated with the propagating x-direction structure [nondim] + real :: cos_ky, sin_ky ! Cosine and sine associated with the y-direction structure [nondim] real :: omega ! Frequency of the shelf wave [T-1 ~> s-1] - real :: alpha - real :: x, y, jj, kk, ll + real :: alpha ! Exponential decay rate in the y-direction [km-1] + real :: x, y ! Positions relative to the western and southern boundaries [km] + real :: kk ! y-direction wavenumber of the wave [km-1] + real :: ll ! x-direction wavenumber of the wave [km-1] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, n integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() @@ -158,7 +168,6 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) omega = CS%omega alpha = CS%alpha my_amp = 1.0*US%m_s_to_L_T - jj = CS%jj kk = CS%kk ll = CS%ll do n = 1, OBC%number_of_segments From dba12c13b0ab2191391c62ae8affad2d58d891e7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Dec 2022 09:31:53 -0500 Subject: [PATCH 078/213] +Document units in dye_example Added units arguments to 4 get_param calls in dye_example. This commit also adds comments describing the units of several internal real variables in this same file. All answers and output are bitwise identical, but there are minor changes in the MOM_parameter_doc files of cases that use this tracer package. --- src/tracer/dye_example.F90 | 48 ++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 1aae1d3367..2244993447 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -41,14 +41,18 @@ module regional_dyes type, public :: dye_tracer_CS ; private integer :: ntr !< The number of tracers that are actually used. logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. - real, allocatable, dimension(:) :: dye_source_minlon !< Minimum longitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. + real, allocatable, dimension(:) :: dye_source_minlon !< Minimum longitude of region dye will be + !! injected, in [m] or [km] or [degrees_E] + real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be + !! injected, in [m] or [km] or [degrees_E] + real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be + !! injected, in [m] or [km] or [degrees_N] + real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be + !! injected, in [m] or [km] or [degrees_N] real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected [Z ~> m]. real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected [Z ~> m]. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine [CU ~> conc] integer, allocatable, dimension(:) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. @@ -74,7 +78,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) !! structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and diffusion module. - type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control structure ! Local variables character(len=40) :: mdl = "regional_dyes" ! This module's name. @@ -82,7 +86,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) character(len=48) :: desc_name ! The variable's descriptor. ! This include declares and sets the variable "version". # include "version_variable.h" - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers [CU ~> conc] logical :: register_dye_tracer integer :: isd, ied, jsd, jed, nz, m isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -110,28 +114,32 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%dye_source_minlon(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINLON", CS%dye_source_minlon, & "This is the starting longitude at which we start injecting dyes.", & - fail_if_missing=.true.) + units="degrees_E", fail_if_missing=.true.) + ! units=G%x_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_minlon(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLON ") CS%dye_source_maxlon(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXLON", CS%dye_source_maxlon, & "This is the ending longitude at which we finish injecting dyes.", & - fail_if_missing=.true.) + units="degrees_E", fail_if_missing=.true.) + ! units=G%x_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_maxlon(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLON ") CS%dye_source_minlat(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINLAT", CS%dye_source_minlat, & "This is the starting latitude at which we start injecting dyes.", & - fail_if_missing=.true.) + units="degrees_N", fail_if_missing=.true.) + ! units=G%y_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_minlat(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLAT ") CS%dye_source_maxlat(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXLAT", CS%dye_source_maxlat, & "This is the ending latitude at which we finish injecting dyes.", & - fail_if_missing=.true.) + units="degrees_N", fail_if_missing=.true.) + ! units=G%y_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_maxlat(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLAT ") @@ -211,10 +219,10 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C do m= 1, CS%ntr do j=G%jsd,G%jed ; do i=G%isd,G%ied ! A dye is set dependent on the center of the cell being inside the rectangular box. - if (CS%dye_source_minlon(m)=G%geoLonT(i,j) .and. & - CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & + if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. & + CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. & + CS%dye_source_minlat(m) < G%geoLatT(i,j) .and. & + CS%dye_source_maxlat(m) >= G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then z_bot = 0.0 do k = 1, GV%ke @@ -264,7 +272,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US !! fluxes can be applied [H ~> m or kg m-2] ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-3] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] integer :: i, j, k, is, ie, js, je, nz, m @@ -292,10 +300,10 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US do m=1,CS%ntr do j=G%jsd,G%jed ; do i=G%isd,G%ied ! A dye is set dependent on the center of the cell being inside the rectangular box. - if (CS%dye_source_minlon(m)=G%geoLonT(i,j) .and. & - CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & + if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. & + CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. & + CS%dye_source_minlat(m) < G%geoLatT(i,j) .and. & + CS%dye_source_maxlat(m) >= G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then z_bot = 0.0 do k=1,nz From 022531cd1a929f8269b83496518cf5ac340bd169 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 17 Dec 2022 08:02:22 -0500 Subject: [PATCH 079/213] Reorder i- and j-loops to be stride-1 in memory Swapped the order of the i- and j- loops in 13 places in 6 files so that they will be stride-1 in memory for efficiency, and to follow the established patterns elsewhere in the MOM6 code. All answers are bitwise identical. --- src/diagnostics/MOM_spatial_means.F90 | 4 ++-- src/initialization/MOM_shared_initialization.F90 | 10 +++++----- src/tracer/MOM_tracer_advect.F90 | 4 ++-- src/user/Phillips_initialization.F90 | 8 ++++---- src/user/RGC_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 4 ++-- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index 551b821645..502475d3f3 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -367,7 +367,7 @@ subroutine global_i_mean(array, i_mean, G, mask, scale, tmp_scale) asum(j) = real_to_EFP(0.0) ; mask_sum(j) = real_to_EFP(0.0) enddo - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(scalefac*array(i,j)*mask(i,j)) mask_sum(j+jdg_off) = mask_sum(j+jdg_off) + real_to_EFP(mask(i,j)) enddo ; enddo @@ -392,7 +392,7 @@ subroutine global_i_mean(array, i_mean, G, mask, scale, tmp_scale) else do j=G%jsg,G%jeg ; asum(j) = real_to_EFP(0.0) ; enddo - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(scalefac*array(i,j)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 53bfe851b0..bea5210c2e 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -323,12 +323,12 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth PI = 4.0*atan(1.0) if (trim(topog_config) == "flat") then - do i=is,ie ; do j=js,je ; D(i,j) = max_depth ; enddo ; enddo + do j=js,je ; do i=is,ie ; D(i,j) = max_depth ; enddo ; enddo elseif (trim(topog_config) == "spoon") then D0 = (max_depth - Dedge) / & ((1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay))) * & (1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay)))) - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie ! This sets a bowl shaped (sort of) bottom topography, with a ! ! maximum depth of max_depth. ! D(i,j) = Dedge + D0 * & @@ -343,7 +343,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! This sets a bowl shaped (sort of) bottom topography, with a ! maximum depth of max_depth. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie D(i,j) = Dedge + D0 * & (sin(PI * (G%geoLonT(i,j) - G%west_lon) / G%len_lon) * & ((1.0 - exp(-(G%geoLatT(i,j) - G%south_lat)*G%Rad_Earth_L*PI/ & @@ -353,7 +353,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth enddo ; enddo elseif (trim(topog_config) == "halfpipe") then D0 = max_depth - Dedge - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie D(i,j) = Dedge + D0 * ABS(sin(PI*(G%geoLatT(i,j) - G%south_lat)/G%len_lat)) enddo ; enddo else @@ -362,7 +362,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth endif ! This is here just for safety. Hopefully it doesn't do anything. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie if (D(i,j) > max_depth) D(i,j) = max_depth if (D(i,j) < min_depth) D(i,j) = 0.5*min_depth enddo ; enddo diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 6d238a8e86..5abca6e578 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -157,7 +157,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, @@ -167,7 +167,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) enddo ; enddo else - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie hprev(i,j,k) = vol_prev(i,j,k) enddo ; enddo endif diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 97d26f7ee2..06b3ed43d6 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -68,7 +68,7 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The fractional depth where the stratification is centered.", & - units="nondim", default = 0.5, do_not_log=just_read) + units="nondim", default=0.5, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -262,10 +262,10 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) first_call = .false. call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The fractional depth where the stratificaiton is centered.", & - units="nondim", default = 0.5) + units="nondim", default=0.5) call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", & - units="s-1", default = 1.0/(10.0*86400.0), scale=US%T_to_s) + units="s-1", default=1.0/(10.0*86400.0), scale=US%T_to_s) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & @@ -352,7 +352,7 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) y1=G%south_lat+0.5*G%len_lat+offset-0.5*Wtop; y2=y1+Wtop x1=G%west_lon+0.1*G%len_lon; x2=x1+Ltop; x3=x1+dist; x4=x3+3.0/2.0*Ltop - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie D(i,j)=0.0 if (G%geoLonT(i,j)>x1 .and. G%geoLonT(i,j)= (G%len_lon - lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 9ed2881563..7d1656e191 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -268,12 +268,12 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & enddo enddo - do k=1,nz ; do i=is,ie ; do j=js,je + do k=1,nz ; do j=js,je ; do i=is,ie T(i,j,k) = T0(k) S(i,j,k) = S0(k) enddo ; enddo ; enddo PI = 4.0*atan(1.0) - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie SST = 0.5*(T0(k1)+T0(nz)) - 0.9*0.5*(T0(k1)-T0(nz)) * & cos(PI*(G%geoLatT(i,j)-G%south_lat)/(G%len_lat)) do k=1,k1-1 From 43fd2e1a13807fad3b2cff2403be8925c71aed31 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sun, 18 Dec 2022 21:56:26 -0500 Subject: [PATCH 080/213] Made STANLEY_COEFF<0 warnings be fatal We were issuing a WARNING when the user indicates to use the STANLEY contribution to density but if the coefficient is negative we were toggling the logical flag but only issuing a warning. This would lead to users getting a result there were not expecting. Better for the run to fail so they can set the coefficient to non-negative. --- src/core/MOM_PressureForce_FV.F90 | 6 ++---- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 6 ++---- src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 | 6 ++---- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 6 ++---- 4 files changed, 8 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 854b6b788c..dfacb40001 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -869,10 +869,8 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & "Coefficient correlating the temperature gradient and SGS T variance.", & units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) then - call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_PGF is true.") - CS%use_stanley_pgf = .false. - endif + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_PGF is true.") CS%id_rho_pgf = register_diag_field('ocean_model', 'rho_pgf', diag%axesTL, & Time, 'rho in PGF', 'kg m-3', conversion=US%R_to_kg_m3) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 1aede30a74..2a26349b02 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1214,10 +1214,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & "Coefficient correlating the temperature gradient and SGS T variance.", & units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) then - call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ISO is true.") - CS%use_stanley_iso = .false. - endif + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ISO is true.") endif if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 5d87761363..94f4468433 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -897,10 +897,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & "Coefficient correlating the temperature gradient and SGS T variance.", & units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) then - call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") - CS%use_stanley_ml = .false. - endif + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") endif call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & 'The value the von Karman constant as used for mixed layer viscosity.', & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b8d5e4c89c..33492337a7 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -2107,10 +2107,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & "Coefficient correlating the temperature gradient and SGS T variance.", & units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) then - call MOM_error(WARNING, "STANLEY_COEFF must be set >= 0 if USE_STANLEY_GM is true.") - CS%use_stanley_gm = .false. - endif + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_GM is true.") endif call get_param(param_file, mdl, "OMEGA", omega, & "The rotation rate of the earth.", & From 8e603a1cd74ce0625a200f8922070f99afba5892 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 21 Oct 2022 19:08:43 -0500 Subject: [PATCH 081/213] State-dependent options for diag coordinates Reference pressure and the compressibility fraction could previously only be set for coordinates if they were used as the main prognostic coordinate. This updates the logic to allow these parameters to be changed for diagnostic coordinates. To avoid, naming clashes with the prognostic coordinate, new function was written to construct the correct parameter name. Other places within the codebase where this occurred have subsequently been refactored. --- src/ALE/MOM_regridding.F90 | 42 +++++++++++++++++++++++++++++++------- 1 file changed, 35 insertions(+), 7 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 27dd1ab4d5..e1b4703d7c 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -179,6 +179,9 @@ module MOM_regridding !> Default minimum thickness for some coordinate generation modes real, parameter, public :: regriddingDefaultMinThickness = 1.e-3 +!> Maximum length of parameters +integer, parameter :: MAX_PARAM_LENGTH = 120 + #undef __DO_SAFETY_CHECKS__ contains @@ -199,7 +202,8 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m ! Local variables integer :: ke ! Number of levels character(len=80) :: string, string2, varName ! Temporary strings - character(len=40) :: coord_units, param_name, coord_res_param ! Temporary strings + character(len=40) :: coord_units, coord_res_param ! Temporary strings + character(len=MAX_PARAM_LENGTH) :: param_name character(len=200) :: inputdir, fileName character(len=320) :: message ! Temporary strings character(len=12) :: expected_units, alt_units ! Temporary strings @@ -256,7 +260,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m param_name = "INTERPOLATION_SCHEME" string2 = regriddingDefaultInterpScheme else - param_name = trim(param_prefix)//"_INTERP_SCHEME_"//trim(param_suffix) + param_name = create_coord_param(param_prefix, "INTERP_SCHEME", param_suffix) string2 = 'PPM_H4' ! Default for diagnostics endif call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & @@ -309,8 +313,8 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m coord_res_param = "ALE_RESOLUTION" string2 = 'UNIFORM' else - param_name = trim(param_prefix)//"_DEF_"//trim(param_suffix) - coord_res_param = trim(param_prefix)//"_RES_"//trim(param_suffix) + param_name = create_coord_param(param_prefix, "DEF", param_suffix) + coord_res_param = create_coord_param(param_prefix, "RES", param_suffix) string2 = 'UNIFORM' if (maximum_depth>3000.) string2='WOA09' ! For convenience endif @@ -545,13 +549,14 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m ! initialise coordinate-specific control structure call initCoord(CS, GV, US, coord_mode, param_file) - if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mdl, "P_REF", P_Ref, & + if (coord_is_state_dependent) then + call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & "The pressure that is used for calculating the coordinate "//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) - call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & + call get_param(param_file, mdl, create_coord_param(param_prefix, "REGRID_COMPRESSIBILITY_FRACTION", param_suffix), & + tmpReal, & "When interpolating potential density profiles we can add "//& "some artificial compressibility solely to make homogeneous "//& "regions appear stratified.", units="nondim", default=0.) @@ -2564,6 +2569,29 @@ subroutine dz_function1( string, dz ) end subroutine dz_function1 +!> Construct the name of a parameter for a specific coordinate based on param_prefix and param_suffix. For the main, +!! prognostic coordinate this will simply return the parameter name (e.g. P_REF) +function create_coord_param(param_prefix, param_name, param_suffix) result(coord_param) + character(len=*) :: param_name !< The base name of the parameter (e.g. the one used for the main coordinate) + character(len=*) :: param_prefix !< String to prefix to parameter names. + character(len=*) :: param_suffix !< String to append to parameter names. + character(len=MAX_PARAM_LENGTH) :: coord_param !< Parameter name prepended by param_prefix + !! and appended with param_suffix + integer :: out_length + + if (len_trim(param_prefix) + len_trim(param_suffix) == 0) then + coord_param = param_name + else + ! Note the +2 is because of two underscores + out_length = len_trim(param_name)+len_trim(param_prefix)+len_trim(param_suffix)+2 + if (out_length > MAX_PARAM_LENGTH) then + call MOM_error(FATAL,"Coordinate parameter is too long; increase MAX_PARAM_LENGTH") + endif + coord_param = TRIM(param_prefix)//"_"//TRIM(param_name)//"_"//TRIM(param_suffix) + endif + +end function create_coord_param + !> Parses a string and generates a rho_target(:) profile with refined resolution downward !! and returns the number of levels integer function rho_function1( string, rho_target ) From ced34c5c32204676cca9dac3c1b1d358f77b788d Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 23 Nov 2022 01:11:55 +0000 Subject: [PATCH 082/213] Ensure ref_pressure propagates to RHO/HYCOM CS The ref_pressure was being passed into the set_regrid_params routine, however additional lines needed to be added for the RHO and HYCOM coordinates so that the value would be injected into their control structures. Setting the same target densities for two diagnostic RHO coordinates, but with different reference pressures now yield different results. --- src/ALE/MOM_regridding.F90 | 3 ++- src/ALE/coord_hycom.F90 | 4 +++- src/ALE/coord_rho.F90 | 5 ++++- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index e1b4703d7c..ad40239874 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -2437,13 +2437,14 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(min_thickness)) call set_sigma_params(CS%sigma_CS, min_thickness=min_thickness) case (REGRIDDING_RHO) if (present(min_thickness)) call set_rho_params(CS%rho_CS, min_thickness=min_thickness) + if (present(ref_pressure)) call set_rho_params(CS%rho_CS, ref_pressure=ref_pressure) if (present(integrate_downward_for_e)) & call set_rho_params(CS%rho_CS, integrate_downward_for_e=integrate_downward_for_e) if (associated(CS%rho_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & call set_rho_params(CS%rho_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYCOM1) if (associated(CS%hycom_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & - call set_hycom_params(CS%hycom_CS, interp_CS=CS%interp_CS) + call set_hycom_params(CS%hycom_CS, interp_CS=CS%interp_CS, ref_pressure=ref_pressure) case (REGRIDDING_HYBGEN) ! Do nothing for now. case (REGRIDDING_SLIGHT) diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 5a3ffaff52..56c0d8d0d1 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -69,11 +69,13 @@ subroutine end_coord_hycom(CS) end subroutine end_coord_hycom !> This subroutine can be used to set the parameters for the coord_hycom module -subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS) +subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS, ref_pressure) type(hycom_CS), pointer :: CS !< Coordinate control structure real, dimension(:), optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] real, dimension(:), optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation + real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent + !! coordinates [R L2 T-2 ~> Pa] if (.not. associated(CS)) call MOM_error(FATAL, "set_hycom_params: CS not associated") diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 0cbf025b94..8454c4be1d 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -67,12 +67,14 @@ subroutine end_coord_rho(CS) end subroutine end_coord_rho !> This subroutine can be used to set the parameters for the coord_rho module -subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS) +subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS, ref_pressure) type(rho_CS), pointer :: CS !< Coordinate control structure real, optional, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface !! positions from the top downward. If false, integrate !! from the bottom upward, as does the rest of the model. + real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent + !! coordinates [R L2 T-2 ~> Pa] type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation @@ -81,6 +83,7 @@ subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS if (present(min_thickness)) CS%min_thickness = min_thickness if (present(integrate_downward_for_e)) CS%integrate_downward_for_e = integrate_downward_for_e if (present(interp_CS)) CS%interp_CS = interp_CS + if (present(ref_pressure)) CS%ref_pressure = ref_pressure end subroutine set_rho_params !> Build a rho coordinate column From 053752d886e51b63ce4c91da50d8bd5b5e28db41 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 19 Dec 2022 16:25:59 -0800 Subject: [PATCH 083/213] Update diagnostic P_REF description As pointed out by @adcroft, the hybrid coordinate should not generally be used for diagnostic purposes. The description for P_REF when initializing a diagnostic coordinate has been updated to reflect this. --- src/ALE/MOM_regridding.F90 | 20 ++++++++++++++------ src/ALE/coord_hycom.F90 | 4 +--- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index ad40239874..e28f2c5e82 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -550,11 +550,19 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call initCoord(CS, GV, US, coord_mode, param_file) if (coord_is_state_dependent) then - call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & - "The pressure that is used for calculating the coordinate "//& - "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& - "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & - units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + if (main_parameters) then + call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & + "The pressure that is used for calculating the coordinate "//& + "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& + "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & + units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + else + call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & + "The pressure that is used for calculating the diagnostic coordinate "//& + "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& + "This is only used for the RHO coordinate.", & + units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + endif call get_param(param_file, mdl, create_coord_param(param_prefix, "REGRID_COMPRESSIBILITY_FRACTION", param_suffix), & tmpReal, & "When interpolating potential density profiles we can add "//& @@ -2444,7 +2452,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri call set_rho_params(CS%rho_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYCOM1) if (associated(CS%hycom_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & - call set_hycom_params(CS%hycom_CS, interp_CS=CS%interp_CS, ref_pressure=ref_pressure) + call set_hycom_params(CS%hycom_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYBGEN) ! Do nothing for now. case (REGRIDDING_SLIGHT) diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 56c0d8d0d1..5a3ffaff52 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -69,13 +69,11 @@ subroutine end_coord_hycom(CS) end subroutine end_coord_hycom !> This subroutine can be used to set the parameters for the coord_hycom module -subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS, ref_pressure) +subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS) type(hycom_CS), pointer :: CS !< Coordinate control structure real, dimension(:), optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] real, dimension(:), optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation - real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent - !! coordinates [R L2 T-2 ~> Pa] if (.not. associated(CS)) call MOM_error(FATAL, "set_hycom_params: CS not associated") From 7869030ff2f29d3398d50cd233cc126275cfdd71 Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Fri, 23 Dec 2022 06:22:43 -0700 Subject: [PATCH 084/213] Add GL90 parameterization for stacked shallow water (#268) This adds a new vertical viscosity parameterization as in Greatbatch and Lamb (1990), Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, and is the equivalent of the Gent & McWilliams (1990) parameterization, but in a TWA (thickness-weighted averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM via thermal wind balance, and the following relation: nu = kappa_GM * f^2 / N^2. The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary conditions at the top and bottom. In the current implementation, kappa_GM is assumed either (a) constant or as (b) having an EBT structure. A third possible formulation of nu is depth-independent: nu = f^2 * alpha The latter formulation would be equivalent to a kappa_GM that varies as N^2 with depth. Currently, the GL90 parameterization is only implemented in stacked shallow water (SSW) mode, in which case we have 1/N^2 = h/g'. More specifically, this commit adds a new subroutine that computes the coupling coefficient associated with GL90 via a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' or a_cpl_gl90 = nu / h = f^2 * alpha / h. Further, a_cpl_gl90 is multiplied by a function (botfn), which is 0 within the GL90 bottom boundary layer, whose depth is set by Hbbl_gl90, and 1 otherwise. This modification is necessary to avoid fluxing momentum into vanished layers that ride over steep topography. Finally, a_cpl_gl90 is added to a_cpl, where the latter is the coupling coefficient associated with the remaining vertical stresses, used in the vertical viscosity solver. More information can be found in Loose et al. (https://www.essoar.org/doi/abs/10.1002/essoar.10512867.1), Appendix B. * Introduce logical variable KD_GL90_USE_EBT_STRUCT This variable is analogous to KHTH_USE_EBT_STRUCT, but is specifically for the GL90 scheme. If the user sets KD_GL90_USE_EBT_STRUCT = True, an EBT structure will be applied to KD_GL90. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 14 +- .../vertical/MOM_vert_friction.F90 | 282 +++++++++++++++++- 5 files changed, 289 insertions(+), 25 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f438c14a05..748748f77f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -567,7 +567,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -660,7 +660,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & - CS%OBC) + CS%OBC, VarMix) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%AD_pred, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") @@ -880,7 +880,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index bc20c30a0f..a0a6633811 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -345,7 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) dt_visc = 0.5*dt ; if (CS%use_correct_dt_visc) dt_visc = dt_pred - call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_visc, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 957306eb3d..85f5d6c546 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(u_in, v_in, h_av, tv, forces, visc, dt_visc, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) @@ -392,10 +392,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2a26349b02..f5dd0defdc 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -48,6 +48,8 @@ module MOM_lateral_mixing_coeffs !! of first baroclinic wave for calculating the resolution fn. logical :: khth_use_ebt_struct !< If true, uses the equivalent barotropic structure !! as the vertical structure of thickness diffusivity. + logical :: kdgl90_use_ebt_struct !< If true, uses the equivalent barotropic structure + !! as the vertical structure of diffusivity in the GL90 scheme. logical :: calculate_cg1 !< If true, calls wave_speed() to calculate the first !! baroclinic wave speed and populate CS%cg1. !! This parameter is set depending on other parameters. @@ -229,7 +231,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%calculate_cg1) then if (.not. allocated(CS%cg1)) call MOM_error(FATAL, & "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") - if (CS%khth_use_ebt_struct) then + if (CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct) then if (.not. allocated(CS%ebt_struct)) call MOM_error(FATAL, & "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then @@ -1177,6 +1179,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, uses the equivalent barotropic structure "//& "as the vertical structure of thickness diffusivity.",& default=.false.) + call get_param(param_file, mdl, "KD_GL90_USE_EBT_STRUCT", CS%kdgl90_use_ebt_struct, & + "If true, uses the equivalent barotropic structure "//& + "as the vertical structure of diffusivity in the GL90 scheme.",& + default=.false.) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", KhTh_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", default=0.0) @@ -1194,7 +1200,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) default=1.0e-17, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) - CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn .or. CS%khth_use_ebt_struct + CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn .or. CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE ! Indicate whether to calculate the Eady growth rate CS%calculate_Eady_growth_rate = use_MEKE .or. (KhTr_Slope_Cff>0.) .or. (KhTh_Slope_Cff>0.) @@ -1218,7 +1224,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ISO is true.") endif - if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then + if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct) then in_use = .true. call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & "The depth below which N2 is monotonized to avoid stratification "//& @@ -1568,7 +1574,7 @@ end subroutine VarMix_init subroutine VarMix_end(CS) type(VarMix_CS), intent(inout) :: CS - if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) & + if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct) & deallocate(CS%ebt_struct) if (CS%use_stored_slopes) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index af7ceef46a..eadd35b86e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -13,6 +13,7 @@ module MOM_vert_friction use MOM_forcing_type, only : mech_forcing use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data, slasher use MOM_open_boundary, only : ocean_OBC_type, 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 @@ -24,6 +25,7 @@ module MOM_vert_friction use MOM_variables, only : ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS +use MOM_lateral_mixing_coeffs, only : VarMix_CS implicit none ; private #include @@ -49,10 +51,24 @@ module MOM_vert_friction !! from the surface; this can get very large with thin layers. real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. + real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [H ~> m or kg m-2]. real :: Kv_extra_bbl !< An extra vertical viscosity in the bottom boundary layer of thickness !! Hbbl when there is not a bottom drag law in use [Z2 T-1 ~> m2 s-1]. real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] + logical :: use_GL90_in_SSW !< If true, use the GL90 parameterization in stacked shallow water mode (SSW). + !! The calculation of the GL90 viscosity coefficient uses the fact that in SSW + !! we simply have 1/N^2 = h/g^prime, where g^prime is the reduced gravity. + !! This identity does not generalize to non-SSW setups. + logical :: use_GL90_N2 !< If true, use GL90 vertical viscosity coefficient that is depth-independent; + !! this corresponds to a kappa_GM that scales as N^2 with depth. + real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme + !! [L2 T-1 ~> m2 s-1] + logical :: read_kappa_gl90 !< If true, read a file containing the spatially varying kappa_gl90 + real :: alpha_gl90 !< Coefficient used to compute a depth-independent GL90 vertical + !! viscosity via Kv_gl90 = alpha_gl90 * f^2. Note that the implied + !! Kv_gl90 corresponds to a kappa_gl90 that scales as N^2 with depth. + !! [L2 T ~> m2 s] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -73,10 +89,14 @@ module MOM_vert_friction real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-1]. + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & + a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-1]. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & + a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -133,6 +153,7 @@ module MOM_vert_friction type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. + real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 T-1 ~> m2 s-1] !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 @@ -154,6 +175,119 @@ module MOM_vert_friction contains +!> Compute coupling coefficient associated with vertical viscosity parameterization as in Greatbatch and Lamb +!! (1990), hereafter referred to as the GL90 vertical viscosity parameterization. This vertical viscosity scheme +!! redistributes momentum in the vertical, and is the equivalent of the Gent & McWilliams (1990) parameterization, +!! but in a TWA (thickness-weighted averaged) set of equations. The vertical viscosity coefficient nu is computed +!! from kappa_GM via thermal wind balance, and the following relation: +!! nu = kappa_GM * f^2 / N^2. +!! In the following subroutine kappa_GM is assumed either (a) constant or (b) horizontally varying. In both cases, +!! (a) and (b), one can additionally impose an EBT structure in the vertical for kappa_GM. +!! A third possible formulation of nu is depth-independent: +!! nu = f^2 * alpha +!! The latter formulation would be equivalent to a kappa_GM that varies as N^2 with depth. +!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary +!! conditions at the top and bottom. +!! +!! In SSW mode, we have 1/N^2 = h/g'. The coupling coefficient is therefore equal to +!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' +!! or +!! a_cpl_gl90 = nu / h = f^2 * alpha / h + +subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u) + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity + !! grid point [H ~> m or kg m-2]. + logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient + !! for a column + real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the + !! bottom, normalized by the GL90 bottom + !! boundary layer thickness + real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated + !! with GL90 across interfaces; is not + !! included in a_cpl [Z T-1 ~> m s-1]. + integer, intent(in) :: j !< j-index to find coupling coefficient for + type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients + logical, intent(in) :: work_on_u !< If true, u-points are being calculated, + !! otherwise they are v-points. + + ! local variables + logical :: kdgl90_use_ebt_struct + integer :: i, k, is, ie, nz, Isq, Ieq + real :: f2 !< Squared Coriolis parameter at a + !! velocity grid point [T-2 ~> s-2]. + real :: h_neglect ! A thickness that is so small + !! it is usually lost in roundoff error + !! and can be neglected [H ~> m or kg m-2]. + real :: botfn ! A function that is 1 at the bottom + !! and small far from it [nondim] + real :: z2 ! The distance from the bottom, + !! normalized by Hbbl_gl90 [nondim] + + is = G%isc ; ie = G%iec + Isq = G%IscB ; Ieq = G%IecB + nz = GV%ke + + h_neglect = GV%H_subroundoff + kdgl90_use_ebt_struct = .false. + if (VarMix%use_variable_mixing) then + kdgl90_use_ebt_struct = VarMix%kdgl90_use_ebt_struct + endif + + if (work_on_u) then + ! compute coupling coefficient at u-points + do I=Isq,Ieq; if (do_i(I)) then + f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 + do K=2,nz + if (CS%use_GL90_N2) then + a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1) + h_neglect) + else + if (CS%read_kappa_gl90) then + a_cpl_gl90(I,K) = f2 * 0.5 * (CS%kappa_gl90_2d(i,j) + CS%kappa_gl90_2d(i+1,j)) / GV%g_prime(K) + else + a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + endif + if (kdgl90_use_ebt_struct) then + a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + endif + endif + ! botfn determines when a point is within the influence of the GL90 bottom boundary layer, + ! going from 1 at the bottom to 0 in the interior. + z2 = z_i(I,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * (1 - botfn) + enddo + endif; enddo + else + ! compute viscosities at v-points + do i=is,ie; if (do_i(i)) then + f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 + do K=2,nz + if (CS%use_GL90_N2) then + a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1) + h_neglect) + else + if (CS%read_kappa_gl90) then + a_cpl_gl90(i,K) = f2 * 0.5 * (CS%kappa_gl90_2d(i,j) + CS%kappa_gl90_2d(i,j+1)) / GV%g_prime(K) + else + a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + endif + if (kdgl90_use_ebt_struct) then + a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + endif + endif + ! botfn determines when a point is within the influence of the GL90 bottom boundary layer, + ! going from 1 at the bottom to 0 in the interior. + z2 = z_i(i,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * (1 - botfn) + enddo + endif; enddo + endif + +end subroutine find_coupling_coef_gl90 + !> Perform a fully implicit vertical diffusion !! of momentum. Stress top and bottom boundary conditions are used. !! @@ -671,10 +805,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) end subroutine vertvisc_remnant -!> Calculate the coupling coefficients (CS%a_u and CS%a_v) +!> Calculate the coupling coefficients (CS%a_u, CS%a_v, CS%a_u_gl90, CS%a_v_gl90) !! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the !! applying the implicit vertical viscosity via vertvisc(). -subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) +subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -689,7 +823,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure - + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients ! Field from forces used in this subroutine: ! ustar: the friction velocity [Z T-1 ~> m s-1], used here as the mixing ! velocity in the mixed layer if NKML > 1 in a bulk mixed layer. @@ -706,14 +840,21 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. + a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1]. + ! a_cpl_gl90 times the velocity difference gives the GL90 stress across an interface. + ! a_cpl_gl90 is part of a_cpl. a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. - z_i ! An estimate of each interface's height above the bottom, + z_i, & ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness [nondim] + z_i_gl90 ! An estimate of each interface's height above the bottom, + ! normalized by the GL90 bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. + I_Hbbl_gl90, &! The inverse of the bottom boundary layer thickness used for the GL90 scheme + ! [H-1 ~> m-1 or m2 kg-1]. I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. zcol1, & ! The height of the interfaces to the north and south of a zcol2, & ! v-point [H ~> m or kg m-2]. @@ -761,6 +902,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) h_neglect = GV%H_subroundoff a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) + if (CS%use_GL90_in_SSW) then + I_Hbbl_gl90 = 1.0 / (CS%Hbbl_gl90 + h_neglect) + endif I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val if (CS%id_Kv_u > 0) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) @@ -864,6 +1008,23 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) + a_cpl_gl90(:,:) = 0.0 + if (CS%use_GL90_in_SSW) then + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that + ! no momentum gets fluxed into vanished layers. The scheme is not + ! sensitive to the exact value of Hbbl_gl90, as long as it is in a + ! reasonable range (~1-20 m): large enough to capture vanished layers + ! over topography, small enough to not contaminate the interior. + do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo + do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I) + endif ; enddo ; enddo ! i & k loops + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) + endif + if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo endif @@ -913,13 +1074,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then - CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) + CS%a_u(I,j,K) = min(a_cpl_max, (forces%frac_shelf_u(I,j) * a_shelf(I,K) + & + (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) + a_cpl_gl90(I,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & ! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) elseif (do_i(I)) then - CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then ! Should we instead take the inverse of the average of the inverses? @@ -929,7 +1091,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) CS%h_u(I,j,k) = hvel(I,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) + endif; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) + endif; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo endif @@ -1031,6 +1198,25 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) + a_cpl_gl90(:,:) = 0.0 + if (CS%use_GL90_in_SSW) then + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that + ! no momentum gets fluxed into vanished layers. The scheme is not + ! sensitive to the exact value of Hbbl_gl90, as long as it is in a + ! reasonable range (~1-20 m): large enough to capture vanished layers + ! over topography, small enough to not contaminate the interior. + do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo + + do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then + z_i_gl90(i,k) = z_i_gl90(i,k+1) + h_harm(i,k)*I_Hbbl_gl90(i) + endif ; enddo ; enddo ! i & k loops + + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) + endif + if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo endif @@ -1079,13 +1265,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then - CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) + CS%a_v(i,J,K) = min(a_cpl_max, (forces%frac_shelf_v(i,J) * a_shelf(i,k) + & + (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) + a_cpl_gl90(i,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & ! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) elseif (do_i(i)) then - CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) + CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) + CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then ! Should we instead take the inverse of the average of the inverses? @@ -1095,7 +1282,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) CS%h_v(i,J,k) = hvel(i,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then + CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) + endif ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then + CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) + endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo endif @@ -1798,6 +1990,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & !! use an arbitrary and hard-coded maximum viscous coupling coefficient !! between layers. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + character(len=200) :: kappa_gl90_file, inputdir, kdgl90_varname ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. @@ -1917,6 +2110,68 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T) + call get_param(param_file, mdl, "USE_GL90_IN_SSW", CS%use_GL90_in_SSW, & + "If true, use simpler method to calculate 1/N^2 in GL90 vertical "// & + "viscosity coefficient. This method is valid in stacked shallow water mode.", & + default=.false.) + call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & + "The scalar diffusivity used in GL90 vertical viscosity "//& + "scheme.", units="m2 s-1", default=0.0, & + scale=US%m_to_Z**2*US%T_to_s, do_not_log=.not.CS%use_GL90_in_SSW) + call get_param(param_file, mdl, "READ_KD_GL90", CS%read_kappa_gl90, & + "If true, read a file (given by KD_GL90_FILE) containing the "//& + "spatially varying diffusivity KD_GL90 used in the GL90 scheme.", default=.false., & + do_not_log=.not.CS%use_GL90_in_SSW) + if (CS%read_kappa_gl90) then + if (CS%kappa_gl90 > 0) then + call MOM_error(FATAL, "MOM_vert_friction.F90, vertvisc_init: KD_GL90 > 0 "// & + "is not compatible with READ_KD_GL90 = .TRUE. ") + endif + call get_param(param_file, mdl, "INPUTDIR", inputdir, & + "The directory in which all input files are found.", & + default=".", do_not_log=.true.) + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "KD_GL90_FILE", kappa_gl90_file, & + "The file containing the spatially varying diffusivity used in the "// & + "GL90 scheme.", default="kd_gl90.nc", do_not_log=.not.CS%use_GL90_in_SSW) + call get_param(param_file, mdl, "KD_GL90_VARIABLE", kdgl90_varname, & + "The name of the GL90 diffusivity variable to read "//& + "from KD_GL90_FILE.", default="kd_gl90", do_not_log=.not.CS%use_GL90_in_SSW) + kappa_gl90_file = trim(inputdir) // trim(kappa_gl90_file) + + allocate(CS%kappa_gl90_2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + call MOM_read_data(kappa_gl90_file, kdgl90_varname, CS%kappa_gl90_2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call pass_var(CS%kappa_gl90_2d, G%domain) + endif + call get_param(param_file, mdl, "USE_GL90_N2", CS%use_GL90_N2, & + "If true, use GL90 vertical viscosity coefficient that is depth-independent; "// & + "this corresponds to a kappa_GM that scales as N^2 with depth.", & + default=.false., do_not_log=.not.CS%use_GL90_in_SSW) + if (CS%use_GL90_N2) then + if (.not. CS%use_GL90_in_SSW) call MOM_error(FATAL, & + "MOM_vert_friction.F90, vertvisc_init: "//& + "When USE_GL90_N2=True, USE_GL90_in_SSW must also be True.") + if (CS%kappa_gl90 > 0) then + call MOM_error(FATAL, "MOM_vert_friction.F90, vertvisc_init: KD_GL90 > 0 "// & + "is not compatible with USE_GL90_N2 = .TRUE. ") + endif + if (CS%read_kappa_gl90) call MOM_error(FATAL, & + "MOM_vert_friction.F90, vertvisc_init: "//& + "READ_KD_GL90 = .TRUE. is not compatible with USE_GL90_N2 = .TRUE.") + call get_param(param_file, mdl, "alpha_GL90", CS%alpha_gl90, & + "Coefficient used to compute a depth-independent GL90 vertical "//& + "viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// & + "if USE_GL90_N2 is true. Note that the implied Kv_GL90 "// & + "corresponds to a KD_GL90 that scales as N^2 with depth.", & + units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T, & + do_not_log=.not.CS%use_GL90_in_SSW) + endif + call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, & + "The thickness of the GL90 bottom boundary layer, "//& + "which defines the range over which the GL90 coupling "//& + "coefficient is zeroed out, in order to avoid fluxing "//& + "momentum into vanished layers over steep topography.", & + units="m", default=5.0, scale=GV%m_to_H, do_not_log=.not.CS%use_GL90_in_SSW) CS%Kvml_invZ2 = 0.0 if (GV%nkml < 1) then @@ -2021,8 +2276,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 + ALLOC_(CS%a_u_gl90(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u_gl90(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 + ALLOC_(CS%a_v_gl90(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v_gl90(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & @@ -2218,6 +2475,7 @@ subroutine vertvisc_end(CS) DEALLOC_(CS%a_v) ; DEALLOC_(CS%h_v) if (associated(CS%a1_shelf_u)) deallocate(CS%a1_shelf_u) if (associated(CS%a1_shelf_v)) deallocate(CS%a1_shelf_v) + if (allocated(CS%kappa_gl90_2d)) deallocate(CS%kappa_gl90_2d) end subroutine vertvisc_end !> \namespace mom_vert_friction From 747eeffcb5d641f949236e74eb823af6d802e109 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Dec 2022 06:39:05 -0500 Subject: [PATCH 085/213] Rescale internal vars in reset_face_lengths_list Apply dimensional rescaling immediately after reading the open face width and porous barrier depth variables in reset_face_lengths_list to facilitate the detection of improperly scaled variables or incorrect unit declarations throughout the code. Also eliminated unnecessary local copies of rescaling factors in the MOM_porous_barriers module. All answers are bitwise identical. --- src/core/MOM_porous_barriers.F90 | 33 ++++++++----------- .../MOM_shared_initialization.F90 | 30 ++++++++++------- 2 files changed, 32 insertions(+), 31 deletions(-) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 0e48cf07fd..c1eb749467 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -69,8 +69,8 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable !! used to dilate the layer thicknesses !! [H ~> m or kg m-2]. - type(porous_barrier_type), intent(inout) :: pbv !< porous barrier fractional cell metrics - type(porous_barrier_CS), intent(in) :: CS !< Control structure for porous barrier + type(porous_barrier_type), intent(inout) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_CS), intent(in) :: CS !< Control structure for porous barrier !local variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: eta_u ! Layer interface heights at u points [Z ~> m] @@ -80,9 +80,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points ! updated while moving up layers real :: A_layer ! Integral of fractional open width from bottom to current layer [Z ~> m] - real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. - real :: h_neglect, & ! Negligible thicknesses, often [Z ~> m] - h_min ! ! The minimum layer thickness, often [Z ~> m] + real :: h_min ! ! The minimum layer thickness [Z ~> m] real :: dmask ! The depth below which porous barrier is not applied [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -102,9 +100,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) call calc_eta_at_uv(eta_u, eta_v, CS%eta_interp, dmask, h, tv, G, GV, US) - Z_to_eta = 1.0 - H_to_eta = GV%H_to_m * US%m_to_Z * Z_to_eta - h_min = GV%Angstrom_H * H_to_eta + h_min = GV%Angstrom_H * GV%H_to_Z ! u-points do j=js,je ; do I=Isq,Ieq ; do_I(I,j) = .False. ; enddo ; enddo @@ -203,8 +199,6 @@ subroutine porous_widths_interface(h, tv, G, GV, US, pbv, CS, eta_bt) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: eta_v ! Layer interface height at v points [Z ~> m] logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points ! updated while moving up layers - real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. - real :: h_neglect ! Negligible thicknesses, often [Z ~> m] real :: dmask ! The depth below which porous barrier is not applied [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -292,8 +286,7 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt) ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m or 1/eta_to_m]. - real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. - real :: h_neglect ! Negligible thicknesses, often [Z ~> m] + real :: h_neglect ! Negligible thicknesses [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc; ie = G%iec; js = G%jsc; je = G%jec; nk = GV%ke @@ -302,9 +295,7 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt) ! currently no treatment for using optional find_eta arguments if present call find_eta(h, tv, G, GV, US, eta, halo_size=1) - Z_to_eta = 1.0 - H_to_eta = GV%H_to_m * US%m_to_Z * Z_to_eta - h_neglect = GV%H_subroundoff * H_to_eta + h_neglect = GV%H_subroundoff * GV%H_to_Z do K=1,nk+1 do j=js,je ; do I=Isq,Ieq ; eta_u(I,j,K) = dmask ; enddo ; enddo @@ -365,8 +356,8 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, A_layer, do_next) logical, intent(out) :: do_next !< False if eta_layer>D_max ! local variables - real :: m, & ! convenience constant for fit [nondim] - zeta ! normalized vertical coordinate [nondim] + real :: m ! convenience constant for fit [nondim] + real :: zeta ! normalized vertical coordinate [nondim] do_next = .True. if (eta_layer <= D_min) then @@ -398,8 +389,8 @@ subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next) logical, intent(out) :: do_next !< False if eta_layer>D_max ! local variables - real :: m, a, & ! convenience constant for fit [nondim] - zeta ! normalized vertical coordinate [nondim] + real :: m, a ! convenience constants for fit [nondim] + real :: zeta ! normalized vertical coordinate [nondim] do_next = .True. if (eta_layer <= D_min) then @@ -407,12 +398,14 @@ subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next) elseif (eta_layer > D_max) then w_layer = 1.0 do_next = .False. - else + else ! The following option could be refactored for stability and efficiency (with fewer divisions) m = (D_avg - D_min) / (D_max - D_min) a = (1.0 - m) / m zeta = (eta_layer - D_min) / (D_max - D_min) if (m < 0.5) then w_layer = zeta**(1.0 / a) + ! Note that this would be safer and more efficent if it were rewritten as: + ! w_layer = zeta**( (D_avg - D_min) / (D_max - D_avg) ) elseif (m == 0.5) then w_layer = zeta else diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index bea5210c2e..73be3f5843 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -819,14 +819,14 @@ subroutine reset_face_lengths_list(G, param_file, US) real, allocatable, dimension(:,:) :: & u_lat, u_lon, v_lat, v_lon ! The latitude and longitude ranges of faces [degrees_N] or [degrees_E] real, allocatable, dimension(:) :: & - u_width, v_width ! The open width of faces [m] + u_width, v_width ! The open width of faces [L ~> m] integer, allocatable, dimension(:) :: & u_line_no, v_line_no, & ! The line numbers in lines of u- and v-face lines u_line_used, v_line_used ! The number of times each u- and v-line is used. real, allocatable, dimension(:) :: & - Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] + Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [Z ~> m] real, allocatable, dimension(:) :: & - Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [m] + Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [Z ~> m] real :: lat, lon ! The latitude and longitude of a point [degrees_N] and [degrees_E]. real :: len_lon ! The periodic range of longitudes, usually 360 degrees [degrees_E]. real :: len_lat ! The range of latitudes, usually 180 degrees [degrees_N]. @@ -945,6 +945,10 @@ subroutine reset_face_lengths_list(G, param_file, US) read(line(isu_por+12:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt), & Dmin_u(u_pt), Dmax_u(u_pt), Davg_u(u_pt) endif + u_width(u_pt) = US%m_to_L*u_width(u_pt) ! Rescale units equivalently to scale=US%m_to_L during read. + Dmin_u(u_pt) = US%m_to_Z*Dmin_u(u_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Dmax_u(u_pt) = US%m_to_Z*Dmax_u(u_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Davg_u(u_pt) = US%m_to_Z*Davg_u(u_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. u_line_no(u_pt) = ln if (is_root_PE()) then if (check_360) then @@ -982,6 +986,10 @@ subroutine reset_face_lengths_list(G, param_file, US) read(line(isv+12:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt), & Dmin_v(v_pt), Dmax_v(v_pt), Davg_v(v_pt) endif + v_width(v_pt) = US%m_to_L*v_width(v_pt) ! Rescale units equivalently to scale=US%m_to_L during read. + Dmin_v(v_pt) = US%m_to_Z*Dmin_v(v_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Dmax_v(v_pt) = US%m_to_Z*Dmax_v(v_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Davg_v(v_pt) = US%m_to_Z*Davg_v(v_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. v_line_no(v_pt) = ln if (is_root_PE()) then if (check_360) then @@ -1027,10 +1035,10 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(US%m_to_L*u_width(npt), 0.0)) - G%porous_DminU(I,j) = US%m_to_Z*Dmin_u(npt) - G%porous_DmaxU(I,j) = US%m_to_Z*Dmax_u(npt) - G%porous_DavgU(I,j) = US%m_to_Z*Davg_u(npt) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%porous_DminU(I,j) = Dmin_u(npt) + G%porous_DmaxU(I,j) = Dmax_u(npt) + G%porous_DavgU(I,j) = Davg_u(npt) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then @@ -1064,10 +1072,10 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(US%m_to_L*v_width(npt), 0.0)) - G%porous_DminV(i,J) = US%m_to_Z*Dmin_v(npt) - G%porous_DmaxV(i,J) = US%m_to_Z*Dmax_v(npt) - G%porous_DavgV(i,J) = US%m_to_Z*Davg_v(npt) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%porous_DminV(i,J) = Dmin_v(npt) + G%porous_DmaxV(i,J) = Dmax_v(npt) + G%porous_DavgV(i,J) = Davg_v(npt) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then From 3794b83f7eea62a7a95a693e0c918aae881c43f0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Dec 2022 18:27:03 -0500 Subject: [PATCH 086/213] (+)Better units documentation in tracer_hordiff This commit includes minor cleanup of the units documentation in several of the process parameterization routines. These changes include: - Change the units of the (apparently unused) optional read_khdt_[xy] arguments to tracer_hordiff from [m2] to [L2 ~> m2] - Correct a tiny number used for safety in the denominator of a normalization factor based on the (nondimensional) masks from H_subroundoff to a tiny nondimensional number, giving an expression that is dimensionally consistent. Without this change, the diagnostic "KHTR_h" will vary with large enough negative values of H_RESCALE_POWER. - Replace a local variable in bulkmixedlayer_init with units of time with distinct get_param calls setting the default for BUFFER_LAY_DETRAIN_TIME depending on which buffer layer detrainment scheme is used. - Correct the dimensions of the "land_mask" diagnostic internal_tides_init from "logical" to "nondim", because it is a real multiplicable mask, not a boolean logical mask. - Eliminate the internal variable L2_to_Z2 in the calculate_projected_state routine in MOM_kappa_shear which had been described incorrectly and ultimately was not helpful. - Corrected the allocated size declaration for three 3-d v-face arrays - Add comments highlighting a non-stride-1 loop structure for openMP threading in tracer_epipycnal_ML_diff that required the addition of 3 extra 3-d arrays and might be a performance liability in non-openMP configurations. - Extensive modification of the comments describing the variables in MOM_tracer_hordiff to clearly indicate the units of each real variable and similarly of one variable in MOM_geothermal. All answers are bitwise identical unless very large rescaling is done for thickness units, and the only change in model output is to the documented units of one diagnostic that is not used often, and to the diagnostic "KHTR_h" when large enough negative values of H_RESCALE_POWER are used. --- .../lateral/MOM_internal_tides.F90 | 6 +- .../vertical/MOM_bulk_mixed_layer.F90 | 12 ++- .../vertical/MOM_geothermal.F90 | 10 +- .../vertical/MOM_kappa_shear.F90 | 10 +- src/tracer/MOM_tracer_hor_diff.F90 | 98 +++++++++++-------- 5 files changed, 76 insertions(+), 60 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 8414e27f8c..dc0daecd8e 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -2346,8 +2346,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) default=.false.) call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& - "the velocity field to the bottom stress.", units="nondim", & - default=0.003) + "the velocity field to the bottom stress.", & + units="nondim", default=0.003) call get_param(param_file, mdl, "INTERNAL_TIDE_ENERGIZED_ANGLE", CS%energized_angle, & "If positive, only one angular band of the internal tides "//& "gets all of the energy. (This is for debugging.)", default=-1) @@ -2518,7 +2518,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & - Time, 'Land mask', 'logical') ! used if overriding (BDM) + Time, 'Land mask', 'nondim') ! Output reflection parameters as diags here (not needed every timestep) if (CS%id_refl_ang > 0) call post_data(CS%id_refl_ang, CS%refl_angle, CS%diag) if (CS%id_refl_pref > 0) call post_data(CS%id_refl_pref, CS%refl_pref, CS%diag) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index a00e97a497..0097fd12fa 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -3360,7 +3360,6 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. - real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] real :: omega_frac_dflt ! The default value for ML_OMEGA_FRAC [nondim] real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [Z T-1 ~> m s-1] real :: Hmix_min_m ! The unscaled value of HMIX_MIN [m] @@ -3454,10 +3453,15 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "The minimum buffer layer thickness relative to the combined mixed "//& "land buffer ayer thicknesses when they are thin.", & units="nondim", default=0.1/CS%nkbl) - BL_detrain_time_dflt = 4.0*3600.0 ; if (CS%nkbl==1) BL_detrain_time_dflt = 86400.0*30.0 - call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + if (CS%nkbl==1) then + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & "A timescale that characterizes buffer layer detrainment events.", & - units="s", default=BL_detrain_time_dflt, scale=US%s_to_T) + units="s", default=86400.0*30.0, scale=US%s_to_T) + else + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + "A timescale that characterizes buffer layer detrainment events.", & + units="s", default=4.0*3600.0, scale=US%s_to_T) + endif call get_param(param_file, mdl, "BUFFER_SPLIT_RHO_TOL", CS%BL_split_rho_tol, & "The fractional tolerance for matching layer target densities when splitting "//& "layers to deal with massive interior layers that are lighter than one of the "//& diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index ce19609210..3769721da1 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -107,7 +107,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & T_old, & ! Temperature of each layer before any heat is added, for diagnostics [C ~> degC] h_old, & ! Thickness of each layer before any heat is added, for diagnostics [H ~> m or kg m-2] - work_3d ! Scratch variable used to calculate changes due to geothermal + work_3d ! Scratch variable used to calculate changes due to geothermal [various] real :: Idt ! inverse of the timestep [T-1 ~> s-1] logical :: do_i(SZI_(G)) @@ -407,7 +407,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal_in_place: "//& "Geothermal heating can only be applied if T & S are state variables.") -! do i=is,ie ; do j=js,je +! do j=js,je ; do i=is,ie ! resid(i,j) = tv%internal_heat(i,j) ! enddo ; enddo @@ -573,17 +573,17 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) ! Diagnostic for tendencies due to internal heat (in 3d) - CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & + CS%id_internal_heat_heat_tendency = register_diag_field('ocean_model', & 'internal_heat_heat_tendency', diag%axesTL, Time, & 'Heat tendency (in 3D) due to internal (geothermal) sources', & 'W m-2', conversion=US%QRZ_T_to_W_m2, v_extensive=.true.) - CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & + CS%id_internal_heat_temp_tendency = register_diag_field('ocean_model', & 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & 'degC s-1', conversion=US%C_to_degC*US%s_to_T, v_extensive=.true.) if (.not.useALEalgorithm) then ! Do not offer this diagnostic if heating will be in place. - CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & + CS%id_internal_heat_h_tendency = register_diag_field('ocean_model', & 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & trim(thickness_units)//' s-1', conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 1e8015eacd..590711bc2c 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1061,8 +1061,6 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int ! Local variables real, dimension(nz+1) :: c1 ! A tridiagonal variable [nondim] - real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared [Z2 s2 T-2 m-2 ~> 1]. real :: a_a, a_b ! Tridiagonal coupling coefficients [Z ~> m] real :: b1, b1nz_0 ! Tridiagonal variables [Z-1 ~> m-1] real :: bd1 ! A term in the denominator of b1 [Z ~> m] @@ -1134,16 +1132,14 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int endif ! Store the squared shear at interfaces - ! L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 - L2_to_Z2 = US%L_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (US%L_to_Z*I_dz_int(ks))**2 do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (US%L_to_Z*I_dz_int(K))**2 enddo if (ke A type that can be used to create arrays of pointers to 2D arrays type p2d - real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of reals + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of reals [various] end type p2d !> A type that can be used to create arrays of pointers to 2D integer arrays type p2di @@ -123,12 +123,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online ! Optional inputs for offline tracer transport logical, optional, intent(in) :: do_online_flag !< If present and true, do online !! tracer transport with stored velocities. + ! The next two arguments do not appear to be used anywhere. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: read_khdt_x !< If present, these are the zonal - !! diffusivities from previous run. + optional, intent(in) :: read_khdt_x !< If present, these are the zonal diffusivities + !! times a timestep from a previous run [L2 ~> m2] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: read_khdt_y !< If present, these are the meridional - !! diffusivities from previous run. + optional, intent(in) :: read_khdt_y !< If present, these are the meridional diffusivities + !! times a timestep from a previous run [L2 ~> m2] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -152,10 +153,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. real :: khdt_max ! The local limiting value of khdt_x or khdt_y [L2 ~> m2]. - real :: max_CFL ! The global maximum of the diffusive CFL number. + real :: max_CFL ! The global maximum of the diffusive CFL number [nondim] logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: i, j, k, m, is, ie, js, je, nz, ntr, itt, num_itts - real :: I_numitts ! The inverse of the number of iterations, num_itts. + real :: I_numitts ! The inverse of the number of iterations, num_itts [nondim] real :: scale ! The fraction of khdt_x or khdt_y that is applied in this ! layer for this iteration [nondim]. real :: Idt ! The inverse of the time step [T-1 ~> s-1]. @@ -164,7 +165,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. - real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. + real :: normalize ! normalization used for diagnostic Kh_h [nondim]; diffusivity averaged to h-points. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -337,11 +338,11 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else ! .not. do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = US%m_to_L**2*read_khdt_x(I,j) + khdt_x(I,j) = read_khdt_x(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = US%m_to_L**2*read_khdt_y(i,J) + khdt_y(i,J) = read_khdt_y(i,J) enddo ; enddo call pass_vector(khdt_x, khdt_y, G%Domain) endif ! do_online @@ -561,7 +562,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online enddo ; enddo do j=js,je ; do i=is,ie normalize = 1.0 / ((G%mask2dCu(I-1,j)+G%mask2dCu(I,j)) + & - (G%mask2dCv(i,J-1)+G%mask2dCv(i,J)) + GV%H_subroundoff) + (G%mask2dCv(i,J-1)+G%mask2dCv(i,J)) + 1.0e-37) Kh_h(i,j) = normalize*G%mask2dT(i,j)*((Kh_u(I-1,j)+Kh_u(I,j)) + & (Kh_v(i,J-1)+Kh_v(i,J))) enddo ; enddo @@ -633,24 +634,36 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Lv, k0a_Lv, & ! The original k-indices of the layers that participate k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. + !### Accumulating the converge into this array one face at a time may lead to a lack of rotational symmetry. real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] - real, dimension(SZI_(G), SZJ_(G),SZK_(GV)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R + + ! The following 3-d arrays were created in 2014 in MOM6 PR#12 to facilitate openMP threading + ! on an i-loop, which might have been ill advised. The k-size extents here might also be problematic. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & + Tr_flux_3d, & ! The tracer flux through pairings at meridional faces [conc H L2 ~> conc m3 or conc kg] + Tr_adj_vert_L, & ! Vertical adjustments to which layer the fluxes go into in the southern + ! columns at meridional face [conc H L2 ~> conc m3 or conc kg] + Tr_adj_vert_R ! Vertical adjustments to which layer the fluxes go into in the northern + ! columns at meridional face [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZK_(GV), SZJ_(G)) :: & rho_srt, & ! The density of each layer of the sorted columns [R ~> kg m-3]. h_srt ! The thickness of each layer of the sorted columns [H ~> m or kg m-2]. integer, dimension(SZI_(G),SZK_(GV), SZJ_(G)) :: & - k0_srt ! The original k-index that each layer of the sorted column - ! corresponds to. + k0_srt ! The original k-index that each layer of the sorted column corresponds to. real, dimension(SZK_(GV)) :: & - h_demand_L, & ! The thickness in the left (_L) or right (_R) column that - h_demand_R, & ! is demanded to match the thickness in the counterpart [H ~> m or kg m-2]. - h_used_L, & ! The summed thickness from the left or right columns that - h_used_R, & ! have actually been used [H ~> m or kg m-2]. - h_supply_frac_L, & ! The fraction of the demanded thickness that can - h_supply_frac_R ! actually be supplied from a layer. + h_demand_L, & ! The thickness in the left column that is demanded to match the thickness + ! in the counterpart [H ~> m or kg m-2]. + h_demand_R, & ! The thickness in the right column that is demanded to match the thickness + ! in the counterpart [H ~> m or kg m-2]. + h_used_L, & ! The summed thickness from the left column that has actually been used [H ~> m or kg m-2] + h_used_R, & ! The summed thickness from the right columns that has actually been used [H ~> m or kg m-2] + h_supply_frac_L, & ! The fraction of the demanded thickness that can actually be supplied + ! from a layer on the left [nondim]. + h_supply_frac_R ! The fraction of the demanded thickness that can actually be supplied + ! from a layer on the right [nondim]. integer, dimension(SZI_(G), SZJ_(G)) :: & num_srt, & ! The number of layers that are sorted in each column. k_end_srt, & ! The maximum index in each column that might need to be @@ -666,17 +679,17 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: h_exclude ! A thickness that layers must attain to be considered ! for inclusion in mixing [H ~> m or kg m-2]. real :: Idt ! The inverse of the time step [T-1 ~> s-1]. - real :: I_maxitt ! The inverse of the maximum number of iterations. + real :: I_maxitt ! The inverse of the maximum number of iterations [nondim] real :: rho_pair, rho_a, rho_b ! Temporary densities [R ~> kg m-3]. - real :: Tr_min_face ! The minimum and maximum tracer concentrations - real :: Tr_max_face ! associated with a pairing [Conc] - real :: Tr_La, Tr_Lb ! The 4 tracer concentrations that might be - real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] - real :: Tr_av_L ! The average tracer concentrations on the left and right - real :: Tr_av_R ! sides of a pairing [Conc]. + real :: Tr_min_face ! The minimum tracer concentration associated with a pairing [Conc] + real :: Tr_max_face ! The maximum tracer concentration associated with a pairing [Conc] + real :: Tr_La, Tr_Lb ! The 2 left-side tracer concentrations that might be associated with a pairing [Conc] + real :: Tr_Ra, Tr_Rb ! The 2 right-side tracer concentrations that might be associated with a pairing [Conc] + real :: Tr_av_L ! The average tracer concentrations on the left side of a pairing [Conc]. + real :: Tr_av_R ! The average tracer concentrations on the right side of a pairing [Conc]. real :: Tr_flux ! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg]. - real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. + real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the two cells that + ! make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. real :: vol ! A cell volume or mass [H L2 ~> m3 or kg]. @@ -690,7 +703,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. - real :: tmp + real :: tmp ! A temporary variable used in swaps [various] real :: p_ref_cv(SZI_(G)) ! The reference pressure for the coordinate density [R L2 T-2 ~> Pa] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -1320,7 +1333,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & h_L = hP_Lv(J)%p(i,k) ; h_R = hP_Rv(J)%p(i,k) Tr_flux = I_maxitt * ((2.0 * h_L * h_R) / (h_L + h_R)) * & khdt_epi_y(i,J) * (Tr_av_L - Tr_av_R) - Tr_flux_3d(i,j,k) = Tr_flux + Tr_flux_3d(i,J,k) = Tr_flux if (deep_wt_Lv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 @@ -1346,7 +1359,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & (vol*wt_a)*(Tr_Lb - Tr_La)) endif endif - Tr_adj_vert_L(i,j,k) = Tr_adj_vert + Tr_adj_vert_L(i,J,k) = Tr_adj_vert endif if (deep_wt_Rv(J)%p(i,k) < 1.0) then @@ -1373,7 +1386,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & (vol*wt_a)*(Tr_Rb - Tr_Ra)) endif endif - Tr_adj_vert_R(i,j,k) = Tr_adj_vert + Tr_adj_vert_R(i,J,k) = Tr_adj_vert endif if (associated(Tr(m)%df2d_y)) & Tr(m)%df2d_y(i,J) = Tr(m)%df2d_y(i,J) + Tr_flux * Idt @@ -1384,25 +1397,28 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & !$OMP deep_wt_Rv,k0a_Rv,Tr_adj_vert_R) & !$OMP private(kLa,kLb,kRa,kRb,wt_b,wt_a) do i=is,ie ; do J=js-1,je ; if (G%mask2dCv(i,J) > 0.0) then + ! The non-stride-1 loop order here is to facilitate openMP threading. However, it might be + ! suboptimal when openMP threading is not used, at which point it might be better to fuse + ! these loope with those that precede it and thereby eliminate the need for three 3-d arrays. do k=1,nPv(i,J) kLb = k0b_Lv(J)%p(i,k); kRb = k0b_Rv(J)%p(i,k) if (deep_wt_Lv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - Tr_flux_3d(i,j,k) + tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - Tr_flux_3d(i,J,k) else kLa = k0a_Lv(J)%p(i,k) wt_b = deep_wt_Lv(J)%p(i,k) ; wt_a = 1.0 - wt_b - tr_flux_conv(i,j,kLa) = tr_flux_conv(i,j,kLa) - (wt_a*Tr_flux_3d(i,j,k) + Tr_adj_vert_L(i,j,k)) - tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,j,k) - Tr_adj_vert_L(i,j,k)) + tr_flux_conv(i,j,kLa) = tr_flux_conv(i,j,kLa) - (wt_a*Tr_flux_3d(i,J,k) + Tr_adj_vert_L(i,J,k)) + tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,J,k) - Tr_adj_vert_L(i,J,k)) endif if (deep_wt_Rv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,j,k) + tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,J,k) else kRa = k0a_Rv(J)%p(i,k) wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b tr_flux_conv(i,j+1,kRa) = tr_flux_conv(i,j+1,kRa) + & - (wt_a*Tr_flux_3d(i,j,k) - Tr_adj_vert_R(i,j,k)) + (wt_a*Tr_flux_3d(i,J,k) - Tr_adj_vert_R(i,J,k)) tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + & - (wt_b*Tr_flux_3d(i,j,k) + Tr_adj_vert_R(i,j,k)) + (wt_b*Tr_flux_3d(i,J,k) + Tr_adj_vert_R(i,J,k)) endif enddo endif ; enddo ; enddo @@ -1455,8 +1471,8 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic type(param_file_type), intent(in) :: param_file !< parameter file type(tracer_hor_diff_CS), pointer :: CS !< horz diffusion control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_tracer_hor_diff" ! This module's name. if (associated(CS)) then From 5a80ec8bbfb57b043aa6dad2bed5d37f8cb1e14e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Dec 2022 14:00:38 -0500 Subject: [PATCH 087/213] Rescale input fields in MOM_tidal_mixing Rescaled 3-d diagnostics and tidal input energies in the MOM_tidal_mixing code so that there is more explicit tested documentation of the units of various fields and arguments, and so that there are conversion factors that can be compared with the declared units of diagnostics, and explicit scale factors in the MOM_read_data calls. All answers are bitwise identical. --- .../vertical/MOM_tidal_mixing.F90 | 47 ++++++++++--------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index fa3dbe4b87..4380ceb4bd 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -49,10 +49,10 @@ module MOM_tidal_mixing real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: N2_int(:,:,:) !< Buoyancy frequency squared at interfaces [T-2 ~> s-2] - real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition [W m-3] + real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition vertical fraction [nondim]? real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme, in UNITS? real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, - !! interpolated to model vertical coordinate [W m-3?] + !! interpolated to model vertical coordinate [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. real, allocatable :: Fl_lowmode(:,:,:) !< vertical flux of tidal turbulent @@ -163,9 +163,9 @@ module MOM_tidal_mixing real, allocatable :: h_src(:) !< tidal constituent input layer thickness [m] real, allocatable :: tidal_qe_2d(:,:) !< Tidal energy input times the local dissipation !! fraction, q*E(x,y), with the CVMix implementation - !! of Jayne et al tidal mixing [W m-2]. + !! of Jayne et al tidal mixing [R Z3 T-3 ~> W m-2]. !! TODO: make this E(x,y) only - real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [R Z3 T-3 ~> W m-2] ! Diagnostics @@ -641,11 +641,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, & - 'input tidal energy dissipated locally interpolated to model vertical coordinates', '') + 'input tidal energy dissipated locally interpolated to model vertical coordinates', & + 'W m-2', conversion=US%RZ3_T3_to_W_m2) endif CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') - else CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & 'Internal Tide Driven Turbulent Kinetic Energy', & @@ -779,7 +779,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int real, dimension(SZK_(GV)+1) :: SchmittnerSocn real, dimension(SZK_(GV)) :: cellHeight ! Height of cell centers [m] real, dimension(SZK_(GV)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input - ! to model coordinates + ! to model coordinates [R Z3 T-3 ~> W m-2] real, dimension(SZK_(GV)+1) :: N2_int_i ! De-scaled interface buoyancy frequency [s-2] real, dimension(SZK_(GV)) :: Schmittner_coeff ! A coefficient in the Schmittner et al (2014) mixing ! parameterization [nondim] @@ -813,7 +813,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int enddo call CVMix_compute_Simmons_invariant( nlev = GV%ke, & - energy_flux = CS%tidal_qe_2d(i,j), & + energy_flux = US%RZ3_T3_to_W_m2*CS%tidal_qe_2d(i,j), & rho = rho_fw, & SimmonsCoeff = Simmons_coeff, & VertDep = vert_dep, & @@ -863,7 +863,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! diagnostics if (allocated(CS%dd%Kd_itidal)) then - CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T * Kd_tidal(:) endif if (allocated(CS%dd%N2_int)) then CS%dd%N2_int(i,j,:) = N2_int(i,:) @@ -916,14 +916,14 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! CVMix API to prevent this redundancy. ! remap from input z coordinate to model coordinate: - tidal_qe_md = 0.0 + tidal_qe_md(:) = 0.0 call remapping_core_h(CS%remap_cs, size(CS%h_src), CS%h_src, CS%tidal_qe_3d_in(i,j,:), & GV%ke, h_m, tidal_qe_md, GV%H_subroundoff, GV%H_subroundoff) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. call CVMix_compute_SchmittnerCoeff( nlev = GV%ke, & - energy_flux = tidal_qe_md(:), & + energy_flux = US%RZ3_T3_to_W_m2*tidal_qe_md(:), & SchmittnerCoeff = Schmittner_coeff, & exp_hab_zetar = exp_hab_zetar, & CVmix_tidal_params_user = CS%CVMix_tidal_params) @@ -1589,7 +1589,8 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, param_file, CS) character(len=200) :: tidal_input_var ! Input file variable name character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. integer :: i, j, isd, ied, jsd, jed - real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] + real, allocatable, dimension(:,:) :: & + tidal_energy_flux_2d ! Input tidal energy flux at T-grid points [R Z3 T-3 ~> W m-2] isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -1605,7 +1606,7 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, param_file, CS) call get_param(param_file, mdl, "TIDAL_DISSIPATION_VAR", tidal_input_var, & "The name in the input file of the tidal energy source for mixing.", & default="wave_dissipation") - call MOM_read_data(tidal_energy_file, tidal_input_var, tidal_energy_flux_2d, G%domain) + call MOM_read_data(tidal_energy_file, tidal_input_var, tidal_energy_flux_2d, G%domain, scale=US%W_m2_to_RZ3_T3) do j=G%jsc,G%jec ; do i=G%isc,G%iec CS%tidal_qe_2d(i,j) = CS%Gamma_itides * tidal_energy_flux_2d(i,j) enddo ; enddo @@ -1629,16 +1630,16 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) ! local variables real, parameter :: C1_3 = 1.0/3.0 real, dimension(SZI_(G),SZJ_(G)) :: & - tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert - tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert + tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert [nondim] + tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert [nondim] real, allocatable, dimension(:) :: & z_t, & ! depth from surface to midpoint of input layer [Z ~> m] z_w ! depth from surface to top of input layer [Z ~> m] real, allocatable, dimension(:,:,:) :: & - tc_m2, & ! input lunar semidiurnal tidal energy flux [W m-2] - tc_s2, & ! input solar semidiurnal tidal energy flux [W m-2] - tc_k1, & ! input lunar diurnal tidal energy flux [W m-2] - tc_o1 ! input lunar diurnal tidal energy flux [W m-2] + tc_m2, & ! input lunar semidiurnal tidal energy flux [R Z3 T-3 ~> W m-2] + tc_s2, & ! input solar semidiurnal tidal energy flux [R Z3 T-3 ~> W m-2] + tc_k1, & ! input lunar diurnal tidal energy flux [R Z3 T-3 ~> W m-2] + tc_o1 ! input lunar diurnal tidal energy flux [R Z3 T-3 ~> W m-2] integer, dimension(4) :: nz_in integer :: k, is, ie, js, je, isd, ied, jsd, jed, i, j @@ -1660,10 +1661,10 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz_in(1))) ! read in tidal constituents - call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) - call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) - call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) - call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain) + call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain, scale=US%W_m2_to_RZ3_T3) + call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain, scale=US%W_m2_to_RZ3_T3) + call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain, scale=US%W_m2_to_RZ3_T3) + call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain, scale=US%W_m2_to_RZ3_T3) ! Note the hard-coded assumption that z_t and z_w in the file are in centimeters. call MOM_read_data(tidal_energy_file, 'z_t', z_t, scale=0.01*US%m_to_Z) call MOM_read_data(tidal_energy_file, 'z_w', z_w, scale=0.01*US%m_to_Z) From ab68e602b187396ce123dc4cb7d7e47a8f11f611 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Dec 2022 14:01:12 -0500 Subject: [PATCH 088/213] Rescale diagnostics from MOM_CVMix_KPP Rescaled 3-d diagnostics in MOM_CVMix_KPP, and do even more of the preliminary calculations in rescaled variables before explicitly recasting variables into MKS units for the calls to the CVMix routines. With this change, all register_diag_field routines in this module (apart from nondimensional diagnostics) have conversion factors that can be tested for correctness can be compared with the declared units of diagnostics. All answers are bitwise identical. --- .../vertical/MOM_CVMix_KPP.F90 | 222 +++++++++++------- 1 file changed, 131 insertions(+), 91 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index d73bba1551..d1d4b1c790 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -140,22 +140,23 @@ module MOM_CVMix_KPP !>@} ! Diagnostics arrays - real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of ocean boundary layer (OBL) [m] - real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [m] without smoothing + real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of ocean boundary layer (OBL) [Z ~> m] + real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [Z ~> m] without smoothing real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent [nondim] - real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [m] + real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [Z ~> m] real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP [nondim] real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [R ~> kg m-3] - real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [m2 s-2] + real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [L2 T-2 ~> m2 s-2] real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer [nondim] real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) [nondim] - real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [s-1] - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] - real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for bulk Ri [m2 s-2] - real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [m2 s-1] - real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [m2 s-1] - real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [m2 s-1] + real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [Z T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [T-1 ~> s-1] + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] + real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for + !! bulk Ri [Z2 T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [C ~> degC] real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [S ~> ppt] real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [L T-1 ~> m s-1] @@ -483,7 +484,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) ! Register diagnostics CS%diag => diag CS%id_OBLdepth = register_diag_field('ocean_model', 'KPP_OBLdepth', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer calculated by [CVMix] KPP', 'meter', & + 'Thickness of the surface Ocean Boundary Layer calculated by [CVMix] KPP', & + 'meter', conversion=US%Z_to_m, & cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') ! CMOR names are placeholders; must be modified by time period @@ -491,7 +493,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) ! omldamax. if (CS%n_smooth > 0) then CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & + 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', & + 'meter', conversion=US%Z_to_m, & cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') endif @@ -499,32 +502,37 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', & 'kg/m3', conversion=US%R_to_kg_m3) CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & - 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', 'm2/s2') + 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', & + 'm2/s2', conversion=US%L_T_to_m_s**2) CS%id_BulkRi = register_diag_field('ocean_model', 'KPP_BulkRi', diag%axesTL, Time, & 'Bulk Richardson number used to find the OBL depth used by [CVMix] KPP', 'nondim') CS%id_Sigma = register_diag_field('ocean_model', 'KPP_sigma', diag%axesTi, Time, & 'Sigma coordinate used by [CVMix] KPP', 'nondim') CS%id_Ws = register_diag_field('ocean_model', 'KPP_Ws', diag%axesTL, Time, & - 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', 'm/s') + 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', & + 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_N = register_diag_field('ocean_model', 'KPP_N', diag%axesTi, Time, & - '(Adjusted) Brunt-Vaisala frequency used by [CVMix] KPP', '1/s') + '(Adjusted) Brunt-Vaisala frequency used by [CVMix] KPP', '1/s', conversion=US%s_to_T) CS%id_N2 = register_diag_field('ocean_model', 'KPP_N2', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by [CVMix] KPP', '1/s2') + 'Square of Brunt-Vaisala frequency used by [CVMix] KPP', '1/s2', conversion=US%s_to_T**2) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & - 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') + 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2', conversion=US%Z_to_m**2*US%s_to_T**2) CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', & 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & - 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') + 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & - 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') + 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & - 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', 'm2/s') + 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_NLTt = register_diag_field('ocean_model', 'KPP_NLtransport_heat', diag%axesTi, Time, & 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & @@ -598,18 +606,20 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP !! [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [nondim] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier ! Local variables - integer :: i, j, k ! Loop indices - real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces [m2 s-1] - real, dimension( GV%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces [m2 s-1] - real, dimension( GV%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] + integer :: i, j, k ! Loop indices + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke ) :: z_cell ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: z_inter ! Cell interface heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces in MKS units [m2 s-1] + real, dimension( GV%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces in MKS units [m2 s-1] + real, dimension( GV%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] @@ -643,7 +653,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & !$OMP parallel do default(none) firstprivate(nonLocalTrans) & !$OMP private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & !$OMP surfBuoyFlux, Kdiffusivity, Kviscosity, LangEnhK, sigma, & - !$OMP sigmaRatio) & + !$OMP sigmaRatio, z_inter, z_cell) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, Kt, & !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! loop over horizontal points on processor @@ -665,8 +675,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh - iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh enddo ! k-loop finishes @@ -740,15 +750,23 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & enddo endif + ! Convert columns to MKS units for passing to CVMix + do k = 1, GV%ke + z_cell(k) = US%Z_to_m*cellHeight(k) + enddo + do K = 1, GV%ke+1 + z_inter(K) = US%Z_to_m*iFaceHeight(K) + enddo + call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] Kdiffusivity(:,1), & ! (inout) Total heat diffusivity [m2 s-1] Kdiffusivity(:,2), & ! (inout) Total salt diffusivity [m2 s-1] - iFaceHeight, & ! (in) Height of interfaces [m] - cellHeight, & ! (in) Height of level centers [m] + z_inter(:), & ! (in) Height of interfaces [m] + z_cell(:), & ! (in) Height of level centers [m] Kviscosity(:), & ! (in) Original viscosity [m2 s-1] Kdiffusivity(:,1), & ! (in) Original heat diffusivity [m2 s-1] Kdiffusivity(:,2), & ! (in) Original salt diffusivity [m2 s-1] - CS%OBLdepth(i,j), & ! (in) OBL depth [m] + US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent nonLocalTrans(:,1),& ! (out) Non-local heat transport [nondim] nonLocalTrans(:,2),& ! (out) Non-local salt transport [nondim] @@ -821,14 +839,14 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! Copy 1d data into 3d diagnostic arrays !/ grabbing obldepth_0d for next time step. - CS%OBLdepthprev(i,j)=CS%OBLdepth(i,j) + CS%OBLdepthprev(i,j) = CS%OBLdepth(i,j) if (CS%id_sigma > 0) then CS%sigma(i,j,:) = 0. - if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) + if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight(:)/CS%OBLdepth(i,j) endif - if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = Kdiffusivity(:,1) - if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = Kdiffusivity(:,2) - if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = Kviscosity(:) + if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = US%m2_s_to_Z2_T * Kdiffusivity(:,1) + if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = US%m2_s_to_Z2_T * Kdiffusivity(:,2) + if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = US%m2_s_to_Z2_T * Kviscosity(:) ! Update output of routine if (.not. CS%passiveMode) then @@ -898,19 +916,22 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor ! Local variables - ! Variables in MKS units for passing to CVMix routines - real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] - real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] - real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] - real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] - real, dimension( GV%ke ) :: surfBuoyFlux2 ! Surface buoyancy flux in MKS units [m2 s-3] - real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] + ! Variables for passing to CVMix routines, often in MKS units + real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars in MKS units [m s-1] + real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] + real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] + real, dimension( GV%ke ) :: surfBuoyFlux2 ! Surface buoyancy flux in MKS units [m2 s-3] + real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] + real, dimension( GV%ke ) :: Vt2_1d ! Unresolved squared turbulence velocity for bulk Ri [m2 s-2] + real, dimension( GV%ke ) :: z_cell ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke ) :: OBL_depth ! Cell center depths referenced to surface [m] (positive in ocean) + real, dimension( GV%ke+1 ) :: z_inter ! Cell interface heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: N_col ! A column of buoyancy frequencies at interfaces in MKS units [s-1] real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] - real :: Coriolis ! Coriolis parameter at tracer points [s-1] - real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] + real :: Coriolis ! Coriolis parameter at tracer points in MKS units [s-1] + real :: KPP_OBL_depth ! Boundary layer depth calculated by CVMix_kpp_compute_OBL_depth in MKS units [m] + ! Variables for EOS calculations real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] @@ -918,7 +939,13 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension( 3*GV%ke ) :: Temp_1D ! A column of temperatures [C ~> degC] real, dimension( 3*GV%ke ) :: Salt_1D ! A column of salinities [S ~> ppt] + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [T-2 ~> s-2] + real :: zBottomMinusOffset ! Height of bottom plus a little bit [Z ~> m] real :: GoRho ! Gravitational acceleration in MKS units divided by density [m s-2 R-1 ~> m4 kg-1 s-2] + real :: GoRho_Z_L2 ! Gravitational acceleration divided by density times aspect ratio + ! rescaling [Z T-2 R-1 ~> m4 kg-1 s-2] real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] real :: Uk, Vk ! Layer velocities relative to their averages in the surface layer [L T-1 ~> m s-1] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth [Z ~> m] @@ -957,20 +984,21 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl call cpu_clock_begin(id_clock_KPP_compute_BLD) ! some constants - GoRho = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth / GV%Rho0 + GoRho_Z_L2 = US%L_to_Z**2 * GV%g_Earth / GV%Rho0 + GoRho = US%Z_to_m*US%s_to_T**2 * GoRho_Z_L2 buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor !$OMP parallel do default(none) private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & - !$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, & + !$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, vt2_1d, & !$OMP ksfc, surfHtemp, surfHsalt, surfHu, surfHv, surfHuS, & !$OMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, & - !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, & + !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, N_col, & !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_guess, LA, rho_1D, & - !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2, & - !$OMP BulkRi_1d, zBottomMinusOffset) & + !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, & + !$OMP z_inter, OBL_depth, BulkRi_1d, zBottomMinusOffset) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & - !$OMP Temp, Salt, waves, tv, GoRho, u, v, lamult) + !$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult) do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1003,14 +1031,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh - iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh ! find ksfc for cell where "surface layer" sits - SLdepth_0d = CS%surf_layer_ext*max( US%m_to_Z*max(-cellHeight(k),-iFaceHeight(2) ), CS%minOBLdepth ) + SLdepth_0d = CS%surf_layer_ext*max( max(-cellHeight(k),-iFaceHeight(2) ), CS%minOBLdepth ) ksfc = k do ktmp = 1,k - if (-1.0*iFaceHeight(ktmp+1) >= US%Z_to_m*SLdepth_0d) then + if (-1.0*iFaceHeight(ktmp+1) >= SLdepth_0d) then ksfc = ktmp exit endif @@ -1092,7 +1120,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl enddo ! k-loop finishes if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then - MLD_guess = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) + MLD_guess = max( 1.*US%m_to_Z, abs(CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j)=LA @@ -1109,20 +1137,30 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl km1 = max(1, k-1) kk = 3*(k-1) deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1) - N2_1d(k) = (GoRho * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & - ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) + N2_1d(k) = (GoRho_Z_L2 * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & + ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z) CS%N(i,j,k) = sqrt( max( N2_1d(k), 0.) ) enddo N2_1d(GV%ke+1 ) = 0.0 CS%N(i,j,GV%ke+1 ) = 0.0 + ! Convert columns to MKS units for passing to CVMix + do k = 1, GV%ke + OBL_depth(k) = -US%Z_to_m * cellHeight(k) + z_cell(k) = US%Z_to_m*cellHeight(k) + enddo + do K = 1, GV%ke+1 + N_col(K) = US%s_to_T*CS%N(i,j,K) + z_inter(K) = US%Z_to_m*iFaceHeight(K) + enddo + ! turbulent velocity scales w_s and w_m computed at the cell centers. ! Note that if sigma > CS%surf_layer_ext, then CVMix_kpp_compute_turbulent_scales ! computes w_s and w_m velocity scale at sigma=CS%surf_layer_ext. So we only pass ! sigma=CS%surf_layer_ext for this calculation. call CVMix_kpp_compute_turbulent_scales( & CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext - -cellHeight, & ! (in) Assume here that OBL depth [m] = -cellHeight(k) + OBL_depth, & ! (in) OBL depth [m] surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] @@ -1153,73 +1191,75 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & - zt_cntr = cellHeight(1:GV%ke), & ! Depth of cell center [m] + zt_cntr=z_cell, & ! Depth of cell center [m] delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [m s-2] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] - N_iface=CS%N(i,j,:), & ! Buoyancy frequency [s-1] + N_iface=N_col, & ! Buoyancy frequency [s-1] EFactor=LangEnhVT2, & ! Langmuir enhancement factor [nondim] - LaSL = CS%La_SL(i,j), & ! surface layer averaged Langmuir number [nondim] - bfsfc = surfBuoyFlux, & ! surface buoyancy flux [m2 s-3] - uStar = uStar(i,j), & ! surface friction velocity [m s-1] + LaSL=CS%La_SL(i,j), & ! surface layer averaged Langmuir number [nondim] + bfsfc=surfBuoyFlux, & ! surface buoyancy flux [m2 s-3] + uStar=surfFricVel, & ! surface friction velocity [m s-1] CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces [m] - CS%OBLdepth(i,j), & ! (out) OBL depth [m] + z_inter, & ! (in) Height of interfaces [m] + KPP_OBL_depth, & ! (out) OBL depth [m] CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers [m] + zt_cntr=z_cell, & ! (in) Height of cell centers [m] surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CS%OBLdepth(i,j) = US%m_to_Z * KPP_OBL_depth ! A hack to avoid KPP reaching the bottom. It was needed during development ! because KPP was unable to handle vanishingly small layers near the bottom. if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(US%Z_to_m*CS%deepOBLoffset, -0.1*iFaceHeight(GV%ke+1)) + zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset, -0.1*iFaceHeight(GV%ke+1)) CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif ! apply some constraints on OBLdepth - if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = US%Z_to_m*CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) ! compute unresolved squared velocity for diagnostics if (CS%id_Vt2 > 0) then - CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & - cellHeight(1:GV%ke), & ! Depth of cell center [m] - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] - N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] + Vt2_1d(:) = CVmix_kpp_compute_unresolved_shear( & + z_cell, & ! Depth of cell center [m] + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] + N_iface=N_col, & ! Buoyancy frequency at interface [s-1] EFactor=LangEnhVT2, & ! Langmuir enhancement factor [nondim] LaSL=CS%La_SL(i,j), & ! surface layer averaged Langmuir number [nondim] bfsfc=surfBuoyFlux, & ! surface buoyancy flux [m2 s-3] - uStar=uStar(i,j), & ! surface friction velocity [m s-1] + uStar=surfFricVel, & ! surface friction velocity [m s-1] CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CS%Vt2(i,j,:) = US%m_to_Z*US%T_to_s * Vt2_1d(:) endif ! recompute wscale for diagnostics, now that we in fact know boundary layer depth !BGR consider if LTEnhancement is wanted for diagnostics if (CS%id_Ws > 0) then call CVMix_kpp_compute_turbulent_scales( & - -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate - CS%OBLdepth(i,j), & ! (in) OBL depth [m] + -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters - CS%Ws(i,j,:) = Ws_1d(:) + CS%Ws(i,j,:) = US%m_to_Z*US%T_to_s*Ws_1d(:) endif ! Diagnostics if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) - if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) + if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = US%m_s_to_L_T**2 * deltaU2(:) if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU @@ -1261,10 +1301,10 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local - real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [m] - real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [Z ~> m] + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] ! (negative in the ocean) - real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] ! (negative in the ocean) real :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] real :: dh ! The local thickness used for calculating interface positions [Z ~> m] @@ -1300,8 +1340,8 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h) dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh - iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh enddo ! compute weights @@ -1344,10 +1384,10 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) real, optional, intent(in) :: m_to_BLD_units !< A conversion factor from meters !! to the desired units for BLD [various] ! Local variables - real :: scale ! A dimensional rescaling factor in [Z m-1 ~> 1] or other units. + real :: scale ! A dimensional rescaling factor in [nondim] or other units. integer :: i,j - scale = US%m_to_Z ; if (present(m_to_BLD_units)) scale = m_to_BLD_units + scale = 1.0 ; if (present(m_to_BLD_units)) scale = US%Z_to_m*m_to_BLD_units !$OMP parallel do default(none) shared(BLD, CS, G, scale) do j = G%jsc, G%jec ; do i = G%isc, G%iec From 3310ee3c62e5b8f7fc7f326445c1653b436a1cb1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 18 Dec 2022 09:18:55 -0500 Subject: [PATCH 089/213] Avoid using the unscaled argument to MOM_get_param Avoid using the unscaled argument to MOM_get_param in 5 places in 4 files, and made related changes to avoid using some unscaled variables: - Replace Hmix_min_m (in [m]) with Hmix_min_z (in [Z ~> m]) in bulkmixedlayer_init and then set CS%Hmix_min by rescaling Hmix_min_z to [H ~> m or kg m-2]. - Replace Hmix_m (in [m]) with Hmix_z (in [Z ~> m]) in vertvisc_init, and then set CS%Hmix by rescaling Hmix_z to [H ~> m or kg m-2]. - Add a separate unlogged and unscaled get_param call for FLUXCONST for flux_const_default in the solo_driver surface_forcing_init - Do not rescale FLUXCONST when it is read in the FMS_cap surface_forcing_init. - The Flux_const element of the FMS_cap surface_forcing_CS was not actually being used apart from setting a default for Flux_const_temp and Flux_const_salt, so it was replaced with a local variable in surface_forcing_init. - Added comments better describing the internal variables in surface_forcing_init. All answers and output are bitwise identical. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 35 ++++++++++--------- .../solo_driver/MOM_surface_forcing.F90 | 28 +++++++-------- .../vertical/MOM_bulk_mixed_layer.F90 | 10 +++--- .../vertical/MOM_vert_friction.F90 | 17 ++++----- 4 files changed, 44 insertions(+), 46 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index ccd2183e3c..cd0106ec48 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -110,7 +110,6 @@ module MOM_surface_forcing_gfdl !! salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea !! surface temperature to a specified value. - real :: Flux_const !< Piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_salt !< Piston velocity for surface salt restoring [Z T-1 ~> m s-1] real :: Flux_const_temp !< Piston velocity for surface temp restoring [Z T-1 ~> m s-1] logical :: trestore_SPEAR_ECDA !< If true, modify restoring data wrt local SSS @@ -1244,19 +1243,22 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) !! diagnostic output type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - integer, optional, intent(in) :: wind_stagger !< If present, the staggering of the winds that are - !! being provided in calls to update_ocean_model + integer, optional, intent(in) :: wind_stagger !< If present, the staggering of the winds + !! that are being provided in calls to update_ocean_model ! Local variables - real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. - type(directories) :: dirs - logical :: new_sim, iceberg_flux_diags + real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. + real :: Flux_const_dflt ! A default piston velocity for restoring surface properties [m day-1] + logical :: new_sim ! False if this simulation was started from a restart file + ! or other equivalent files. + logical :: iceberg_flux_diags ! If true, diagnostics of fluxes from icebergs are available. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover ! the answers from the end of 2018. Otherwise, use a simpler ! expression to calculate gustiness. type(time_type) :: Time_frc + type(directories) :: dirs ! A structure containing relevant directory paths and input filenames. character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1265,7 +1267,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) character(len=48) :: flnam character(len=240) :: basin_file integer :: i, j, isd, ied, jsd, jed - real :: unscaled_fluxconst isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -1386,16 +1387,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "production runs.", units="nondim", default=1.0) if (CS%restore_salt) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", Flux_const_dflt, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s, unscaled=unscaled_fluxconst) + units="m day-1", default=0.0) call get_param(param_file, mdl, "FLUXCONST_SALT", CS%Flux_const_salt, & "The constant that relates the restoring surface salt fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - fail_if_missing=.false., default=unscaled_fluxconst, units="m day-1", scale=US%m_to_Z*US%T_to_s) - ! Finish converting CS%Flux_const from m day-1 to [Z T-1 ~> m s-1]. - CS%Flux_const = CS%Flux_const / 86400.0 + units="m day-1", default=Flux_const_dflt, scale=US%m_to_Z*US%T_to_s) + ! Finish converting CS%Flux_const_salt from m day-1 to [Z T-1 ~> m s-1]. Ideally this would be + ! included in the scale factors above, but doing so would change answers because a/b /= a*(1/b). CS%Flux_const_salt = CS%Flux_const_salt / 86400.0 call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & "A file in which to find the surface salinity to use for restoring.", & @@ -1437,16 +1438,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) endif if (CS%restore_temp) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", Flux_const_dflt, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s, unscaled=unscaled_fluxconst) + units="m day-1", default=0.0) call get_param(param_file, mdl, "FLUXCONST_TEMP", CS%Flux_const_temp, & "The constant that relates the restoring surface temperature fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - fail_if_missing=.false., default=unscaled_fluxconst, units="m day-1", scale=US%m_to_Z*US%T_to_s) - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 + units="m day-1", default=Flux_const_dflt, scale=US%m_to_Z*US%T_to_s) + ! Finish converting CS%Flux_const_temp from [m day-1] to [Z T-1 ~> m s-1]. Ideally this would be + ! included in the scale factors above, but doing so would change answers because a/b /= a*(1/b). CS%Flux_const_temp = CS%Flux_const_temp / 86400.0 call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & "A file in which to find the surface temperature to use for restoring.", & diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 3ad06ddb8e..8b1c9aaa27 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -1801,9 +1801,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back "//& - "toward some specified surface state with a rate "//& - "given by FLUXCONST.", default= .false.) + "If true, the buoyancy fluxes drive the model back toward some "//& + "specified surface state with a rate given by FLUXCONST.", default=.false.) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", default=hlf, & units="J/kg", scale=US%J_kg_to_Q) @@ -1814,22 +1813,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & - unscaled=flux_const_default) + default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0) if (CS%use_temperature) then + call get_param(param_file, mdl, "FLUXCONST", flux_const_default, & + default=0.0, units="m day-1", do_not_log=.true.) call get_param(param_file, mdl, "FLUXCONST_T", CS%Flux_const_T, & - "The constant that relates the restoring surface temperature "//& - "flux to the relative surface anomaly (akin to a piston "//& - "velocity). Note the non-MKS units.", & - units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & - default=flux_const_default) + "The constant that relates the restoring surface temperature flux to the "//& + "relative surface anomaly (akin to a piston velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, default=flux_const_default) call get_param(param_file, mdl, "FLUXCONST_S", CS%Flux_const_S, & - "The constant that relates the restoring surface salinity "//& - "flux to the relative surface anomaly (akin to a piston "//& - "velocity). Note the non-MKS units.", & - units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & - default=flux_const_default) + "The constant that relates the restoring surface salinity flux to the "//& + "relative surface anomaly (akin to a piston velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, default=flux_const_default) endif if (trim(CS%buoy_config) == "linear") then @@ -1853,7 +1849,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) + units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 0097fd12fa..cb17884ee7 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -3362,7 +3362,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. real :: omega_frac_dflt ! The default value for ML_OMEGA_FRAC [nondim] real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [Z T-1 ~> m s-1] - real :: Hmix_min_m ! The unscaled value of HMIX_MIN [m] + real :: Hmix_min_z ! The default value of HMIX_MIN [Z ~> m] integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3418,10 +3418,10 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & 'The value the von Karman constant as used for mixed layer viscosity.', & units='nondim', default=0.41) - call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & + call get_param(param_file, mdl, "HMIX_MIN", Hmix_min_Z, & "The minimum mixed layer depth if the mixed layer depth "//& - "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & - unscaled=Hmix_min_m) + "is determined dynamically.", units="m", default=0.0, scale=US%m_to_Z) + CS%Hmix_min = GV%Z_to_H * Hmix_min_Z call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers "//& @@ -3470,7 +3470,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean "//& "depth is less than DEPTH_LIMIT_FLUXES.", & - units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) + units="m", default=0.1*US%Z_to_m*Hmix_min_z, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", & default=7.2921e-5, units="s-1", scale=US%T_to_s) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index eadd35b86e..bc8ef7e893 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1982,7 +1982,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Local variables real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [Z2 T-1 ~> m2 s-1]. - real :: Hmix_m ! A boundary layer thickness [m]. + real :: Hmix_z ! A boundary layer thickness [Z ~> m]. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the @@ -2087,17 +2087,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & default=0.0, units="nondim") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) - if (GV%nkml < 1) & - call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface "//& - "viscosity and diffusivity are elevated when the bulk "//& - "mixed layer is not used.", units="m", scale=GV%m_to_H, & - unscaled=Hmix_m, fail_if_missing=.true.) + if (GV%nkml < 1) then + call get_param(param_file, mdl, "HMIX_FIXED", Hmix_z, & + "The prescribed depth over which the near-surface viscosity and "//& + "diffusivity are elevated when the bulk mixed layer is not used.", & + units="m", scale=US%m_to_Z, fail_if_missing=.true.) + CS%Hmix = GV%Z_to_H * Hmix_z + endif if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & - units="m", default=Hmix_m, scale=GV%m_to_H) + units="m", default=US%Z_to_m*Hmix_z, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & From ec7a57fd87bd34276b6da9dcba8312219c135fc9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 21 Dec 2022 16:45:10 -0500 Subject: [PATCH 090/213] +Add runtime parameters for MOM_wave_interface Added 7 new runtime parameters (LA_DEPTH_MIN, DHH85_MIN_WAVE_FREQ, DHH85_MAX_WAVE_FREQ, RHO_AIR, VISCOSITY_AIR, WAVE_HEIGHT_SCALE_FACTOR and VON_KARMAN_WAVES) to specify the previously hard-coded dimensional parameters in the MOM_wave_interface module. Because there are several different ways to set the parameters related to the Langmuir number calculation, several of these parameters are set in the new private subroutine set_LF17_wave_params, which in turn is called in two different places. Some comments were also added to annotate the units of some of the variables in this module. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for some configurations that use the MOM6 surface wave module. --- src/user/MOM_wave_interface.F90 | 137 ++++++++++++++++++++------------ 1 file changed, 86 insertions(+), 51 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 1a1c06018e..70c0b4c71f 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -140,7 +140,8 @@ module MOM_wave_interface logical :: DataOver_initialized !< Flag for DataOverride Initialization ! Options for computing Langmuir number - real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number + real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number [nondim] + real :: LA_HBL_min !< Minimum boundary layer depth for averaging Langmuir number [Z ~> m] logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number integer :: NumBands = 0 !< Number of wavenumber/frequency partitions to receive @@ -158,8 +159,9 @@ module MOM_wave_interface PrescribedSurfStkX !< Surface Stokes drift if prescribed [L T-1 ~> m s-1] real, allocatable, dimension(:) :: & PrescribedSurfStkY !< Surface Stokes drift if prescribed [L T-1 ~> m s-1] + !### It appears that La_SL is never used. Can it be removed? real, allocatable, dimension(:,:) :: & - La_SL, & !< SL Langmuir number (directionality factored later) + La_SL, & !< SL Langmuir number (directionality factored later) [nondim] !! Horizontal -> H points La_Turb !< Aligned Turbulent Langmuir number [nondim] !! Horizontal -> H points @@ -178,13 +180,20 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber - !> An arbitrary lower-bound on the Langmuir number. Run-time parameter. + !> An arbitrary lower-bound on the Langmuir number [nondim]. Run-time parameter. !! Langmuir number is sqrt(u_star/u_stokes). When both are small !! but u_star is orders of magnitude smaller the Langmuir number could !! have unintended consequences. Since both are small it can be safely capped !! to avoid such consequences. real :: La_min = 0.05 + ! Parameters used in estimating the wind speed or wave properties from the friction velocity + real :: VonKar = -1.0 !< The von Karman coefficient as used in the MOM_wave_interface module [nondim] + real :: rho_air !< A typical density of air at sea level, as used in wave calculations [R ~> kg m-3] + real :: nu_air !< The viscosity of air, as used in wave calculations [Z2 T-1 ~> m2 s-1] + real :: SWH_from_u10sq !< A factor for converting the square of the 10 m wind speed to the + !! significant wave height [Z T2 L-2 ~> s m-2] + ! Options used with the test profile real :: TP_STKX0 !< Test profile x-stokes drift amplitude [L T-1 ~> m s-1] real :: TP_STKY0 !< Test profile y-stokes drift amplitude [L T-1 ~> m s-1] @@ -196,6 +205,8 @@ module MOM_wave_interface logical :: DHH85_is_set !< The if the wave properties have been set when WaveMethod = DHH85. real :: WaveAge !< The fixed wave age used with the DHH85 spectrum [nondim] real :: WaveWind !< Wind speed for the DHH85 spectrum [L T-1 ~> m s-1] + real :: omega_min !< Minimum wave frequency with the DHH85 spectrum [T-1 ~> s-1] + real :: omega_max !< Maximum wave frequency with the DHH85 spectrum [T-1 ~> s-1] type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the @@ -281,12 +292,16 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, & - "The depth (normalized by BLD) to average Stokes drift over in "//& - "Langmuir number calculation, where La = sqrt(ust/Stokes).", & - units="nondim", default=0.04) + "The depth (normalized by BLD) to average Stokes drift over in "//& + "Langmuir number calculation, where La = sqrt(ust/Stokes).", & + units="nondim", default=0.04) + call get_param(param_file, mdl, "LA_DEPTH_MIN", CS%LA_HBL_min, & + "The minimum depth over which to average the Stokes drift in the Langmuir "//& + "number calculation.", units="m", default=0.1, scale=US%m_to_Z) if (StatisticalWaves) then CS%WaveMethod = LF17 + call set_LF17_wave_params(param_file, mdl, US, CS) if (.not.use_waves) return else CS%WaveMethod = NULL_WaveMethod @@ -433,11 +448,18 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar call get_param(param_file, mdl, "DHH85_WIND", CS%WaveWind, & "Wind speed for DHH85 spectrum.", & units='m s-1', default=10.0, scale=US%m_s_to_L_T) + call get_param(param_file, mdl, "DHH85_MIN_WAVE_FREQ", CS%omega_min, & + "Minimum wave frequency for the DHH85 spectrum.", & + units='s-1', default=0.1, scale=US%T_to_s) + call get_param(param_file, mdl, "DHH85_MAX_WAVE_FREQ", CS%omega_max, & + "Maximum wave frequency for the DHH85 spectrum.", & + units='s-1', default=10.0, scale=US%T_to_s) ! The default is about a 30 cm cutoff wavelength. call get_param(param_file, mdl, "STATIC_DHH85", CS%StaticWaves, & "Flag to disable updating DHH85 Stokes drift.", default=.false.) - case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number + case (LF17_STRING) !Li and Fox-Kemper 17 wind-sea Langmuir number CS%WaveMethod = LF17 - case (EFACTOR_STRING)!Li and Fox-Kemper 16 + call set_LF17_wave_params(param_file, mdl, US, CS) + case (EFACTOR_STRING) !Li and Fox-Kemper 16 CS%WaveMethod = EFACTOR case default call MOM_error(FATAL,'Check WAVE_METHOD.') @@ -510,6 +532,32 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar end subroutine MOM_wave_interface_init +!> Set the parameters that are used to determine the averaged Stokes drift and Langmuir numbers +subroutine set_LF17_wave_params(param_file, mdl, US, CS) + type(param_file_type), intent(in) :: param_file !< Input parameter structure + character(len=*), intent(in) :: mdl !< A module name to use in the get_param calls + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure + + ! A separate routine is used to set these parameters because there are multiple ways that the + ! underlying parameterizations are enabled. + + call get_param(param_file, mdl, "VISCOSITY_AIR", CS%nu_air, & + "A typical viscosity of air at sea level, as used in wave calculations", & + units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T) + call get_param(param_file, mdl, "VON_KARMAN_WAVES", CS%vonKar, & + "The value the von Karman constant as used for surface wave calculations.", & + units="nondim", default=0.40) ! The default elsewhere in MOM6 is usually 0.41. + call get_param(param_file, mdl, "RHO_AIR", CS%rho_air, & + "A typical density of air at sea level, as used in wave calculations", & + units="kg m-3", default=1.225, scale=US%kg_m3_to_R) + call get_param(param_file, mdl, "WAVE_HEIGHT_SCALE_FACTOR", CS%SWH_from_u10sq, & + "A factor relating the square of the 10 m wind speed to the significant "//& + "wave height, with a default value based on the Pierson-Moskowitz spectrum.", & + units="s m-2", default=0.0246, scale=US%m_to_Z*US%L_T_to_m_s**2) + +end subroutine set_LF17_wave_params + !> This interface provides the caller with information from the waves control structure. subroutine query_wave_properties(CS, NumBands, WaveNumbers, US) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure @@ -619,21 +667,20 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! Local Variables real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m] - real :: one_cm ! One centimeter in the units of wavelengths [Z ~> m] real :: level_thick ! The thickness of each layer [Z ~> m] real :: min_level_thick_avg ! A minimum layer thickness for inclusion in the average [Z ~> m] real :: DecayScale ! A vertical decay scale in the test profile [Z ~> m] real :: CMN_FAC ! A nondimensional factor [nondim] real :: WN ! Model wavenumber [Z-1 ~> m-1] real :: UStokes ! A Stokes drift velocity [L T-1 ~> m s-1] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] real :: La ! The local Langmuir number [nondim] integer :: ii, jj, kk, b, iim1, jjm1 real :: idt ! 1 divided by the time step [T-1 ~> s-1] if (CS%WaveMethod==EFACTOR) return - one_cm = 0.01*US%m_to_Z + ! The following thickness cut-off would not be needed with the refactoring marked with '###' below. min_level_thick_avg = 1.e-3*US%m_to_Z idt = 1.0/dt @@ -896,7 +943,7 @@ end subroutine Update_Stokes_Drift !> Return the value of (1 - exp(-x))/x, using an accurate expression for small values of x. real function one_minus_exp_x(x) real, intent(in) :: x !< The argument of the function ((1 - exp(-x))/x) [nondim] - real, parameter :: C1_6 = 1.0/6.0 + real, parameter :: C1_6 = 1.0/6.0 ! A rational fraction [nondim] if (abs(x) <= 2.0e-5) then ! The Taylor series expression for exp(-x) gives a more accurate expression for 64-bit reals. one_minus_exp_x = 1.0 - x * (0.5 - C1_6*x) @@ -920,7 +967,7 @@ subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS) integer, dimension(4) :: sizes ! The sizes of the various dimensions of the variable. character(len=48) :: dim_name(4) ! The names of the dimensions of the variable. character(len=20) :: varname ! The name of an input variable for data override. - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] logical :: wavenumber_exists integer :: ndims, b, i, j @@ -1058,9 +1105,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & real, allocatable :: StkBand_X(:), StkBand_Y(:) ! Stokes drifts by band [L T-1 ~> m s-1] integer :: KK, BB - - ! Compute averaging depth for Stokes drift (negative) - Dpt_LASL = min(-0.1*US%m_to_Z, -Waves%LA_FracHBL*HBL) + ! Compute averaging depth for Stokes drift (negative) + Dpt_LASL = -1.0*max(Waves%LA_FracHBL*HBL, Waves%LA_HBL_min) USE_MA = Waves%LA_Misalignment if (present(Override_MA)) USE_MA = Override_MA @@ -1183,19 +1229,14 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift [L T-1 ~> m s-1] - real, intent(out) :: LA !< Langmuir number + real, intent(out) :: LA !< Langmuir number [nondim] ! Local variables ! parameters - real, parameter :: & - ! ratio of U19.5 to U10 (Holthuijsen, 2007) [nondim] - u19p5_to_u10 = 1.075, & - ! ratio of mean frequency to peak frequency for - ! Pierson-Moskowitz spectrum (Webb, 2011) [nondim] - fm_into_fp = 1.296, & - ! ratio of surface Stokes drift to U10 [nondim] - us_to_u10 = 0.0162, & - ! loss ratio of Stokes transport [nondim] - r_loss = 0.667 + real, parameter :: u19p5_to_u10 = 1.075 ! ratio of U19.5 to U10 (Holthuijsen, 2007) [nondim] + real, parameter :: fm_into_fp = 1.296 ! ratio of mean frequency to peak frequency for + ! Pierson-Moskowitz spectrum (Webb, 2011) [nondim] + real, parameter :: us_to_u10 = 0.0162 ! ratio of surface Stokes drift to U10 [nondim] + real, parameter :: r_loss = 0.667 ! loss ratio of Stokes transport [nondim] real :: UStokes ! The surface Stokes drift [L T-1 ~> m s-1] real :: hm0 ! The significant wave height [Z ~> m] real :: fm ! The mean wave frequency [T-1 ~> s-1] @@ -1210,7 +1251,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! real :: root_2kz ! The square root of twice the peak wavenumber times the ! ! boundary layer depth [nondim] real :: u10 ! The 10 m wind speed [L T-1 ~> m s-1] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] PI = 4.0*atan(1.0) UStokes_sl = 0.0 @@ -1219,12 +1260,12 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! This code should be revised to minimize the number of divisions and cancel out common factors. ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/(1.225*US%kg_m3_to_R)), u10, GV, US, CS) + call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/CS%rho_air), u10, GV, US, CS) ! surface Stokes drift UStokes = us_to_u10*u10 ! ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) - hm0 = 0.0246*US%m_to_Z*US%L_T_to_m_s**2 * u10**2 + hm0 = CS%SWH_from_u10sq * u10**2 ! ! peak frequency (PM, Bouws, 1998) fp = 0.877 * (US%L_to_Z*GV%g_Earth) / (2.0 * PI * u19p5_to_u10 * u10) @@ -1306,13 +1347,13 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) real, dimension(SZK_(GV)), & intent(in) :: H !< Grid thickness [H ~> m or kg m-2] real, dimension(SZK_(GV)), & - intent(in) :: Profile !< Profile of quantity to be averaged [arbitrary] + intent(in) :: Profile !< Profile of quantity to be averaged in arbitrary units [A] !! (used here for Stokes drift) - real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [arbitrary] + real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [A] !! (used here for Stokes drift) !Local variables real :: top, midpoint, bottom ! Depths, negative downward [Z ~> m]. - real :: Sum + real :: Sum ! The depth weighted vertical sum of a quantity [A Z ~> A m] integer :: kk ! Initializing sum @@ -1392,23 +1433,18 @@ subroutine DHH85_mid(GV, US, CS, zpt, UStokes) real :: omega_peak ! The peak wave frequency [T-1 ~> s-1] real :: omega ! The average frequency in the band [T-1 ~> s-1] real :: domega ! The width in frequency of the band [T-1 ~> s-1] - real :: omega_min ! The minimum wave frequency [T-1 ~> s-1] - real :: omega_max ! The maximum wave frequency [T-1 ~> s-1] real :: u10 ! The wind speed for this spectrum [Z T-1 ~> m s-1] real :: wavespec ! The wave spectrum [L Z T ~> m2 s] real :: Stokes ! The Stokes displacement per cycle [L ~> m] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] integer :: Nomega ! The number of wavenumber bands integer :: OI u10 = CS%WaveWind*US%L_to_Z !/ - omega_min = 0.1*US%T_to_s ! Hz - ! Cut off at 30cm for now... - omega_max = 10.*US%T_to_s ! ~sqrt(0.2*g_Earth*2*pi/0.3) NOmega = 1000 - domega = (omega_max-omega_min)/real(NOmega) + domega = (CS%omega_max - CS%omega_min) / real(NOmega) ! if (CS%WaveAgePeakFreq) then @@ -1427,13 +1463,13 @@ subroutine DHH85_mid(GV, US, CS, zpt, UStokes) endif !/ UStokes = 0.0 - omega = omega_min + 0.5*domega + omega = CS%omega_min + 0.5*domega do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) - ! wavespec units = m2s + ! wavespec units [L Z T ~> m2 s] wavespec = US%Z_to_L * (Ann * CS%g_Earth**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn - ! Stokes units m (multiply by frequency range for units of m/s) + ! Stokes units [L ~> m] (multiply by frequency range for units of [L T-1 ~> m s-1]) Stokes = 2.0 * wavespec * omega**3 * & exp( 2.0 * omega**2 * zpt / CS%g_Earth) / CS%g_Earth UStokes = UStokes + Stokes*domega @@ -1461,7 +1497,7 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) ! Local variables real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z L T-2 ~> m2 s-2] real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. - integer :: i,j,k + integer :: i, j, k ! This is a template to think about down-Stokes mixing. ! This is not ready for use... @@ -1824,8 +1860,6 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure ! Local variables - real, parameter :: vonkar = 0.4 ! Should access a get_param von karman - real :: nu ! The viscosity of air [Z2 T-1 ~> m2 s-1] real :: z0sm, z0, z0rough ! Roughness lengths [Z ~> m] real :: u10a ! The previous guess for u10 [L T-1 ~> m s-1] real :: alpha ! A nondimensional factor in a parameterization [nondim] @@ -1838,21 +1872,22 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) ! Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, ! m=0.0017 reproduces the curve in their figure 6. - nu = 1.0e-6*US%m2_s_to_Z2_T ! Should access a get_param for air-viscosity + if (CS%vonKar < 0.0) call MOM_error(FATAL, & + "ust_2_u10_coare3p5 called with a negative value of Waves%vonKar") - z0sm = 0.11 * nu / USTair ! Compute z0smooth from ustar guess + z0sm = 0.11 * CS%nu_air / USTair ! Compute z0smooth from ustar guess u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 - ! For efficiency change the line above to USTair * sqrt(1000.0) or USTair * 31.6227766 . + !### For efficiency change the line above to USTair * sqrt(1000.0) or USTair * 31.6227766 . u10a = 1000.0*US%m_s_to_L_T ! An insanely large upper bound for u10. CT=0 - do while (abs(u10a/u10 - 1.) > 0.001) ! Change this to (abs(u10a - u10) > 0.001*u10) for efficiency. + do while (abs(u10a/u10 - 1.) > 0.001) !### Change this to (abs(u10a - u10) > 0.001*u10) for efficiency. CT=CT+1 u10a = u10 alpha = min(0.028, 0.0017*US%L_T_to_m_s * u10 - 0.005) z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough - CD = ( vonkar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness + CD = ( CS%vonKar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness u10 = US%Z_to_L*USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop ! ends and checks for convergence...CT counter ! makes sure loop doesn't run away if function From 775050b255a95d8fb0c74b38a76c722bad7b23f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 07:30:58 -0500 Subject: [PATCH 091/213] +Add runtime parameter for dumbbell_initialization Added the new runtime parameter DUMBBELL_T_LIGHT to specify the previously hard-coded dimensional parameters in the dumbbell_initialization module. Also used G%x_ax_unit_short to describe the units of the DUMBBELL_LEN. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for the dumbbell test case. --- src/user/dumbbell_initialization.F90 | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 26b382b94c..0b65883eca 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -52,11 +52,10 @@ subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) logical :: dbrotate ! If true, rotate this configuration integer :: i, j - call get_param(param_file, mdl, "DUMBBELL_LEN",dblen, & + call get_param(param_file, mdl, "DUMBBELL_LEN", dblen, & 'Lateral Length scale for dumbbell.', & - units='km', default=600., do_not_log=.false.) - ! units=G%x_ax_unit_short, default=600., do_not_log=.false.) - call get_param(param_file, mdl, "DUMBBELL_FRACTION",dbfrac, & + units=G%x_ax_unit_short, default=600., do_not_log=.false.) + call get_param(param_file, mdl, "DUMBBELL_FRACTION", dbfrac, & 'Meridional fraction for narrow part of dumbbell.', & units='nondim', default=0.5, do_not_log=.false.) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & @@ -275,8 +274,6 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - T_surf = 20.0*US%degC_to_C - ! layer mode call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, default=.false., do_not_log=.true.) if (.not. use_ALE) call MOM_error(FATAL, "dumbbell_initialize_temperature_salinity: "//& @@ -287,6 +284,9 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ call get_param(param_file, mdl, "INITIAL_DENSITY_PROFILE", density_profile, & 'Initial profile shape. Valid values are "linear", "parabolic" '// & 'and "exponential".', default='linear', do_not_log=just_read) + call get_param(param_file, mdl, "DUMBBELL_T_SURF", T_surf, & + 'Initial surface temperature in the DUMBBELL configuration', & + units='degC', default=20., scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_SREF", S_surf, & 'DUMBBELL REFERENCE SALINITY', & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=just_read) @@ -294,9 +294,8 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ 'DUMBBELL salinity range (right-left)', & units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_LEN", dblen, & - 'Lateral Length scale for dumbbell ', & - units='km', default=600., do_not_log=just_read) - ! units=G%x_ax_unit_short, default=600., do_not_log=.false.) + 'Lateral Length scale for dumbbell ', & + units=G%x_ax_unit_short, default=600., do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & default=.false., do_not_log=just_read) @@ -376,8 +375,8 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil nz = GV%ke call get_param(param_file, mdl, "DUMBBELL_SPONGE_TIME_SCALE", sponge_time_scale, & - "The time scale in the reservoir for restoring. If zero, the sponge is disabled.", & - units="s", default=0., scale=US%s_to_T) + "The time scale in the reservoir for restoring. If zero, the sponge is disabled.", & + units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, & 'DUMBBELL REFERENCE SALINITY', & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) From bd0cd8a4eaae066d2945b27be321b3cdd85489dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 07:31:22 -0500 Subject: [PATCH 092/213] +Add runtime parameters for Kelvin_initialization Added the new runtime parameters KELVIN_WAVE_PERIOD, KELVIN_WAVE_SSH_AMP and KELVIN_WAVE_INFLOW_AMP to specify the previously hard-coded dimensional parameters in the Kelvin_initialization module. This change includes the addition of 3 new elements in the Kelvin_OBC_CS type. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for configurations using the Kelvin_initialization module. --- src/user/Kelvin_initialization.F90 | 64 ++++++++++++++++++------------ 1 file changed, 39 insertions(+), 25 deletions(-) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 1684f88a89..88d0cbb482 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -16,7 +16,7 @@ module Kelvin_initialization use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_registry_type -use MOM_unit_scaling, only : unit_scale_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_time_manager, only : time_type, time_type_to_real @@ -35,13 +35,16 @@ module Kelvin_initialization !> Control structure for Kelvin wave open boundaries. type, public :: Kelvin_OBC_CS ; private integer :: mode = 0 !< Vertical mode - real :: coast_angle = 0 !< Angle of coastline [rad] - real :: coast_offset1 = 0 !< Longshore distance to coastal angle [L ~> m] - real :: coast_offset2 = 0 !< Longshore distance to coastal angle [L ~> m] - real :: H0 = 0 !< Bottom depth [Z ~> m] - real :: F_0 !< Coriolis parameter [T-1 ~> s-1] - real :: rho_range !< Density range [R ~> kg m-3] - real :: rho_0 !< Mean density [R ~> kg m-3] + real :: coast_angle = 0 !< Angle of coastline [rad] + real :: coast_offset1 = 0 !< Longshore distance to coastal angle [L ~> m] + real :: coast_offset2 = 0 !< Offshore distance to coastal angle [L ~> m] + real :: H0 = 0 !< Bottom depth [Z ~> m] + real :: F_0 !< Coriolis parameter [T-1 ~> s-1] + real :: rho_range !< Density range [R ~> kg m-3] + real :: rho_0 !< Mean density [R ~> kg m-3] + real :: wave_period !< Period of the mode-0 waves [T ~> s] + real :: ssh_amp !< Amplitude of the sea surface height forcing for mode-0 waves [Z ~> m] + real :: inflow_amp !< Amplitude of the boundary velocity forcing for internal waves [L T-1 ~> m s-1] end type Kelvin_OBC_CS ! This include declares and sets the variable "version". @@ -87,16 +90,28 @@ function register_Kelvin_OBC(param_file, CS, US, OBC_Reg) units="km", default=10.0, scale=1.0e3*US%m_to_L) call get_param(param_file, mdl, "ROTATED_COAST_ANGLE", CS%coast_angle, & "The angle of the southern bondary beyond X=ROTATED_COAST_OFFSET.", & - units="degrees", default=11.3) - CS%coast_angle = CS%coast_angle * (atan(1.0)/45.) ! Convert to radians + units="degrees", default=11.3, scale=atan(1.0)/45.) ! Convert to radians + else + CS%coast_offset1 = 0.0 ; CS%coast_offset2 = 0.0 ; CS%coast_angle = 0.0 endif - if (CS%mode /= 0) then + if (CS%mode == 0) then + call get_param(param_file, mdl, "KELVIN_WAVE_PERIOD", CS%wave_period, & + "The period of the Kelvin wave forcing at the open boundaries. "//& + "The default value is the M2 tide period.", & + units="s", default=12.42*3600.0, scale=US%s_to_T) + call get_param(param_file, mdl, "KELVIN_WAVE_SSH_AMP", CS%ssh_amp, & + "The amplitude of the Kelvin wave sea surface height anomaly forcing "//& + "at the open boundaries.", units="m", default=1.0, scale=US%m_to_Z) + else call get_param(param_file, mdl, "DENSITY_RANGE", CS%rho_range, & units="kg m-3", default=2.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "RHO_0", CS%rho_0, & units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "MAXIMUM_DEPTH", CS%H0, & units="m", default=1000.0, scale=US%m_to_Z, do_not_log=.true.) + call get_param(param_file, mdl, "KELVIN_WAVE_INFLOW_AMP", CS%inflow_amp, & + "The amplitude of the Kelvin wave sea surface inflow velocity forcing "//& + "at the open boundaries.", units="m s-1", default=1.0, scale=US%m_s_to_L_T) endif ! Register the Kelvin open boundary. @@ -126,8 +141,10 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. - real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: coast_offset1, coast_offset2, coast_angle, right_angle + real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: coast_angle ! Angle of coastline [rad] + real :: coast_offset1 ! Longshore distance to coastal angle [L ~> m] + real :: coast_offset2 ! Offshore distance to coastal angle [L ~> m] integer :: i, j call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) @@ -139,22 +156,19 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & units="km", default=10.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_ANGLE", coast_angle, & - units="degrees", default=11.3, do_not_log=.true.) - - coast_angle = coast_angle * (atan(1.0)/45.) ! Convert to radians - right_angle = 2 * atan(1.0) + units="degrees", default=11.3, scale=(atan(1.0)/45.), do_not_log=.true.) ! Convert to radians do j=G%jsc,G%jec ; do i=G%isc,G%iec D(i,j) = max_depth ! Southern side if ((G%geoLonT(i,j) - G%west_lon > coast_offset1) .AND. & (atan2(G%geoLatT(i,j) - G%south_lat + coast_offset2, & - G%geoLonT(i,j) - G%west_lon - coast_offset1) < coast_angle)) & + G%geoLonT(i,j) - G%west_lon - coast_offset1) < coast_angle)) & D(i,j) = 0.5*min_depth ! Northern side if ((G%geoLonT(i,j) - G%west_lon < G%len_lon - coast_offset1) .AND. & (atan2(G%len_lat + G%south_lat + coast_offset2 - G%geoLatT(i,j), & - G%len_lon + G%west_lon - coast_offset1 - G%geoLonT(i,j)) < coast_angle)) & + G%len_lon + G%west_lon - coast_offset1 - G%geoLonT(i,j)) < coast_angle)) & D(i,j) = 0.5*min_depth if (D(i,j) > max_depth) D(i,j) = max_depth @@ -181,10 +195,8 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) real :: N0 ! Brunt-Vaisala frequency times a rescaling of slopes [L Z-1 T-1 ~> s-1] real :: lambda ! Offshore decay scale [L-1 ~> m-1] real :: omega ! Wave frequency [T-1 ~> s-1] - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] real :: depth_tot(SZI_(G),SZJ_(G)) ! The total depth of the ocean [Z ~> m] - integer :: i, j, k, n, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: IsdB, IedB, JsdB, JedB real :: mag_SSH ! An overall magnitude of the external wave sea surface height at the coastline [Z ~> m] real :: mag_int ! An overall magnitude of the internal wave at the coastline [L2 T-2 ~> m2 s-2] real :: x1, y1 ! Various positions [L ~> m] @@ -194,6 +206,8 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) real :: km_to_L_scale ! A scaling factor from longitudes in km to L [L km-1 ~> 1e3] real :: sina, cosa ! The sine and cosine of the coast angle [nondim] type(OBC_segment_type), pointer :: segment => NULL() + integer :: i, j, k, n, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: IsdB, IedB, JsdB, JedB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -214,11 +228,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) enddo ; enddo ; enddo if (CS%mode == 0) then - mag_SSH = 1.0*US%m_to_Z - omega = 2.0 * PI / (12.42 * 3600.0*US%s_to_T) ! M2 Tide period + mag_SSH = CS%ssh_amp + omega = 2.0 * PI / CS%wave_period val1 = sin(omega * time_sec) else - mag_int = 1.0*US%m_s_to_L_T**2 + mag_int = CS%inflow_amp**2 N0 = sqrt((CS%rho_range / CS%rho_0) * (GV%g_Earth / CS%H0)) lambda = PI * CS%mode * CS%F_0 / (CS%H0 * N0) ! Two wavelengths in domain From 40c24c5ad6616d2eecc5ec52dccf39b1b3ec80ac Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 07:31:49 -0500 Subject: [PATCH 093/213] +Add runtime parameters for tidal_bay_initialization Added the new runtime parameters TIDAL_BAY_PERIOD and TIDAL_BAY_SSH_ANOM to specify the previously hard-coded dimensional parameters in the tidal_bay_initialization module. This change includes the addition of 2 new elements in the tidal_bay_OBC_CS type. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for configurations using the tidal_bay_initialization module. --- src/user/tidal_bay_initialization.F90 | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index d25ad0615c..60ce7b4a56 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -25,7 +25,10 @@ module tidal_bay_initialization !> Control structure for tidal bay open boundaries. type, public :: tidal_bay_OBC_CS ; private - real :: tide_flow = 3.0e6 !< Maximum tidal flux [L2 Z T-1 ~> m3 s-1] + real :: tide_flow = 3.0e6 !< Maximum tidal flux with the tidal bay configuration [L2 Z T-1 ~> m3 s-1] + real :: tide_period !< The period associated with the tidal bay configuration [T ~> s-1] + real :: tide_ssh_amp !< The magnitude of the sea surface height anomalies at the inflow + !! with the tidal bay configuration [Z ~> m] end type tidal_bay_OBC_CS contains @@ -43,6 +46,13 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) call get_param(param_file, mdl, "TIDAL_BAY_FLOW", CS%tide_flow, & "Maximum total tidal volume flux.", & units="m3 s-1", default=3.0e6, scale=US%m_s_to_L_T*US%m_to_L*US%m_to_Z) + call get_param(param_file, mdl, "TIDAL_BAY_PERIOD", CS%tide_period, & + "Period of the inflow in the tidal bay configuration.", & + units="s", default=12.0*3600.0, scale=US%s_to_T) + call get_param(param_file, mdl, "TIDAL_BAY_SSH_ANOM", CS%tide_ssh_amp, & + "Magnitude of the sea surface height anomalies at the inflow with the "//& + "tidal bay configuration.", & + units="m", default=0.1, scale=US%m_to_Z) ! Register the open boundaries. call register_OBC(casename, param_file, OBC_Reg) @@ -63,11 +73,11 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the tidal_bay example. - real :: time_sec + real :: time_sec ! Elapsed model time [T ~> s] real :: cff_eta ! The total column thickness anomalies associated with the inflow [H ~> m or kg m-2] real :: my_flux ! The vlume flux through the face [L2 Z T-1 ~> m3 s-1] real :: total_area ! The total face area of the OBCs [L Z ~> m2] - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] real :: flux_scale ! A scaling factor for the areas [m2 H-1 L-1 ~> nondim or m3 kg-1] real, allocatable :: my_area(:,:) ! The total OBC inflow area [m2] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, n @@ -86,10 +96,10 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) flux_scale = GV%H_to_m*US%L_to_m - time_sec = time_type_to_real(Time) - cff_eta = 0.1*GV%m_to_H * sin(2.0*PI*time_sec/(12.0*3600.0)) - my_area=0.0 - my_flux=0.0 + time_sec = US%s_to_T*time_type_to_real(Time) + cff_eta = CS%tide_ssh_amp*GV%Z_to_H * sin(2.0*PI*time_sec / CS%tide_period) + my_area = 0.0 + my_flux = 0.0 segment => OBC%segment(1) do j=segment%HI%jsc,segment%HI%jec ; do I=segment%HI%IscB,segment%HI%IecB @@ -101,7 +111,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif enddo ; enddo total_area = reproducing_sum(my_area) - my_flux = - CS%tide_flow*SIN(2.0*PI*time_sec/(12.0*3600.0)) + my_flux = - CS%tide_flow * SIN(2.0*PI*time_sec / CS%tide_period) do n = 1, OBC%number_of_segments segment => OBC%segment(n) From 47fa47ed26f2eb5e834b034a0ab40fd05b6a8282 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 20 Dec 2022 11:49:19 -0500 Subject: [PATCH 094/213] makedep: Include object file dependencies The current implementation of makedep contains something like a race condition, where the creation of the .mod and .o files may be in an order which breaks the current dependency tree. Currently, .mod depends on .o, and changes to a module do not trigger rebuilds of dependent source. Rather than try to sort out the rule order, which could even depend on compiler internals, this patch just adds both object and module output files as dependencies, and rebuilds if either changes. We might want to come back to this someday and understand the actual order of rule execution. Thanks to Alistair Adcroft (@adcroft) for proposing this solution. --- ac/makedep | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/ac/makedep b/ac/makedep index 5954f1aae5..439679f17d 100755 --- a/ac/makedep +++ b/ac/makedep @@ -136,6 +136,10 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, # Write rule for each object from Fortran for o in sorted(o2F90.keys()): found_mods = [m for m in o2uses[o] if m in all_modules] + found_objs = [mod2o[m] for m in o2uses[o] if m in all_modules] + found_deps = [ + dep for pair in zip(found_mods, found_objs) for dep in pair + ] missing_mods = [m for m in o2uses[o] if m not in all_modules] incs = nested_inc(o2h[o] + o2inc[o], f2F) incdeps = sorted(set([f2F[f] for f in incs if f in f2F])) @@ -145,7 +149,8 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, print("# object:", o, file=file) print("# modules:", ' '.join(o2mods[o]), file=file) print("# uses:", ' '.join(o2uses[o]), file=file) - print("# found:", ' '.join(found_mods), file=file) + print("# found mods:", ' '.join(found_mods), file=file) + print("# found objs:", ' '.join(found_objs), file=file) print("# missing:", ' '.join(missing_mods), file=file) print("# includes_all:", ' '.join(incs), file=file) print("# includes_pth:", ' '.join(incdeps), file=file) @@ -153,7 +158,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, print("# program:", ' '.join(o2prg[o]), file=file) if o2mods[o]: print(' '.join(o2mods[o])+':', o, file=file) - print(o + ':', o2F90[o], ' '.join(incdeps+found_mods), file=file) + print(o + ':', o2F90[o], ' '.join(incdeps+found_deps), file=file) print('\t'+fc_rule, ' '.join(incargs), file=file) # Write rule for each object from C From 5f1572f377ee2ddc6ff58ecd63532c6a7da614ae Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 19 Dec 2022 09:37:07 -0500 Subject: [PATCH 095/213] +Revise interfaces to horiz_interp_and_extract Revised the interface to the two horiz_interp_and_extract to eliminate the unused reentrant_x and tripolar_n arguments and to rename the conversion argument to scale and make it the last mandatory argument in anticipation that we might decide to make it optional, similarly to other routines like MOM_read_data. The renaming is because we use 'conversion' to indicate how the internal representation is to be rescaled for output, most prominently in register_diag_field, whereas everywhere else where we are rescaling input to the model's internal units, we use a scale argument. This makes the convention self-consistent across the MOM6 code, and should avoid some confusion. The calls to these routines were updated in 8 places in 4 modules. In 8 places the get_param calls for TRIPOLAR_N or REENTRANT_X that are no longer needed were eliminated as were the associated internal variables. This commit also includes some additions to comments near the changes that were directly tied to this commit. All answers are bitwise identical, but there are changes to a publicly visible interface; code that tries to use the old interface will not compile. --- src/framework/MOM_horizontal_regridding.F90 | 59 ++++++++++--------- .../MOM_state_initialization.F90 | 43 +++++++------- .../MOM_tracer_initialization_from_Z.F90 | 41 +++++++------ src/ocean_data_assim/MOM_oda_driver.F90 | 21 ++++--- .../vertical/MOM_ALE_sponge.F90 | 37 ++++-------- 5 files changed, 97 insertions(+), 104 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index bbb5ae0e15..7a0ace9279 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -250,14 +250,13 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, end subroutine fill_miss_2d !> Extrapolate and interpolate from a file record -subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, & - z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & +subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr_z, mask_z, & + z_in, z_edges_in, missing_value, scale, & homogenize, m_to_Z, answers_2018, ongrid, tr_iter_tol, answer_date) character(len=*), intent(in) :: filename !< Path to file containing tracer to be !! interpolated. character(len=*), intent(in) :: varnam !< Name of tracer in file. - real, intent(in) :: conversion !< Conversion factor for tracer [CU conc-1 ~> 1] integer, intent(in) :: recnum !< Record number of tracer to be read. type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z @@ -271,10 +270,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, allocatable, dimension(:), intent(out) :: z_edges_in !< Cell grid edge values for input data [Z ~> m] real, intent(out) :: missing_value !< The missing value in the returned array, scaled - !! with conversion to avoid accidentally having valid - !! values match missing values [CU ~> conc] - logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction - logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid + !! to avoid accidentally having valid values match + !! missing values [CU ~> conc] + real, intent(in) :: scale !< Scaling factor for tracer into the internal + !! units of the model [CU conc-1 ~> 1] logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions real, optional, intent(in) :: m_to_Z !< A conversion factor from meters to the units @@ -311,7 +310,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, dimension(:), allocatable :: lon_in ! The longitudes in the input file [degreesE] then [radians] real, dimension(:), allocatable :: lat_in ! The latitudes in the input file [degreesN] then [radians] real, dimension(:), allocatable :: lat_inp ! The input file latitudes expanded to the pole [degreesN] then [radians] - real :: max_lat ! The maximum latitude on the input grid [degreeN] + real :: max_lat ! The maximum latitude on the input grid [degreesN] real :: pole ! The sum of tracer values at the pole [conc] real :: max_depth ! The maximum depth of the ocean [Z ~> m] real :: npole ! The number of points contributing to the pole value [nondim] @@ -330,7 +329,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, integer :: isd, ied, jsd, jed ! data domain indices integer :: id_clock_read logical :: debug=.false. - real :: I_scale ! The inverse of the conversion factor for diagnostic output [conc CU-1 ~> 1] + real :: I_scale ! The inverse of the scale factor for diagnostic output [conc CU-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing ! iterations that determines when to stop iterating [CU ~> conc] real :: npoints ! The number of points in an average [nondim] @@ -355,10 +354,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid - dtr_iter_stop = 1.0e-3*conversion + dtr_iter_stop = 1.0e-3*scale if (present(tr_iter_tol)) dtr_iter_stop = tr_iter_tol - I_scale = 1.0 / conversion + I_scale = 1.0 / scale PI_180 = atan(1.0)/45. @@ -371,6 +370,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call cpu_clock_begin(id_clock_read) + ! A note by MJH copied from elsewhere suggests that this code may be using the model connectivity + ! (e.g., reentrant or tripolar) but should use the dataset's connectivity instead. + call get_var_axes_info(trim(filename), trim(varnam), axes_info) if (allocated(z_in)) deallocate(z_in) @@ -418,7 +420,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (.not. found_attr) call MOM_error(FATAL, & "error finding missing value for " // trim(varnam) // & " in file " // trim(filename) // " in hinterp_extrap") - missing_value = conversion * missing_val_in + missing_value = scale * missing_val_in call read_attribute(trim(filename), "scale_factor", scale_factor, & varname=trim(varnam), found=found_attr) @@ -471,7 +473,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, do i=is,ie if (abs(tr_in(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then mask_in(i,j) = 1.0 - tr_in(i,j) = (tr_in(i,j)*scale_factor+add_offset) * conversion + tr_in(i,j) = (tr_in(i,j)*scale_factor+add_offset) * scale else tr_in(i,j) = missing_value endif @@ -511,7 +513,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, do j=1,jdp ; do i=1,id if (abs(tr_inp(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then mask_in(i,j) = 1.0 - tr_inp(i,j) = (tr_inp(i,j)*scale_factor+add_offset) * conversion + tr_inp(i,j) = (tr_inp(i,j)*scale_factor+add_offset) * scale else tr_inp(i,j) = missing_value endif @@ -596,18 +598,17 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle -subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, & - z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & +subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, & + z_in, z_edges_in, missing_value, scale, & homogenize, spongeOngrid, m_to_Z, & answers_2018, tr_iter_tol, answer_date) integer, intent(in) :: fms_id !< A unique id used by the FMS time interpolator type(time_type), intent(in) :: Time !< A FMS time type - real, intent(in) :: conversion !< Conversion factor for tracer. type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z !< Allocatable tracer array on the horizontal - !! model grid and input-file vertical levels. [CU ~> conc] + !! model grid and input-file vertical levels [CU ~> conc] real, allocatable, dimension(:,:,:), intent(out) :: mask_z !< Allocatable tracer mask array on the horizontal !! model grid and input-file vertical levels [nondim] @@ -616,10 +617,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t real, allocatable, dimension(:), intent(out) :: z_edges_in !< Cell grid edge values for input data [Z ~> m] real, intent(out) :: missing_value !< The missing value in the returned array, scaled - !! with conversion to avoid accidentally having valid - !! values match missing values [CU ~> conc] - logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction - logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid + !! to avoid accidentally having valid values match + !! missing values [CU ~> conc] + real, intent(in) :: scale !< Scaling factor for tracer into the internal + !! units of the model [CU conc-1 ~> 1] logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions logical, optional, intent(in) :: spongeOngrid !< If present and true, the sponge data are on the model grid @@ -655,7 +656,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t real, dimension(:), allocatable :: lon_in ! The longitudes in the input file [degreesE] then [radians] real, dimension(:), allocatable :: lat_in ! The latitudes in the input file [degreesN] then [radians] real, dimension(:), allocatable :: lat_inp ! The input file latitudes expanded to the pole [degreesN] then [radians] - real :: max_lat ! The maximum latitude on the input grid [degreeN] + real :: max_lat ! The maximum latitude on the input grid [degreesN] real :: pole ! The sum of tracer values at the pole [conc] real :: max_depth ! The maximum depth of the ocean [Z ~> m] real :: npole ! The number of points contributing to the pole value [nondim] @@ -673,7 +674,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t logical :: debug=.false. logical :: is_ongrid integer :: ans_date ! The vintage of the expressions and order of arithmetic to use - real :: I_scale ! The inverse of the conversion factor for diagnostic output [conc CU-1 ~> 1] + real :: I_scale ! The inverse of the scale factor for diagnostic output [conc CU-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing ! iterations that determines when to stop iterating [CU ~> conc] real :: npoints ! The number of points in an average [nondim] @@ -699,10 +700,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t id_clock_read = cpu_clock_id('(Initialize tracer from Z) read', grain=CLOCK_LOOP) - dtr_iter_stop = 1.0e-3*conversion + dtr_iter_stop = 1.0e-3*scale if (present(tr_iter_tol)) dtr_iter_stop = tr_iter_tol - I_scale = 1.0 / conversion + I_scale = 1.0 / scale PI_180 = atan(1.0)/45. @@ -716,7 +717,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call cpu_clock_begin(id_clock_read) call get_external_field_info(fms_id, size=fld_sz, axes=axes_data, missing=missing_val_in) - missing_value = conversion*missing_val_in + missing_value = scale*missing_val_in verbosity = MOM_get_verbosity() @@ -823,7 +824,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do j=1,jdp ; do i=1,id if (abs(tr_inp(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then mask_in(i,j) = 1.0 - tr_inp(i,j) = tr_inp(i,j) * conversion + tr_inp(i,j) = tr_inp(i,j) * scale else tr_inp(i,j) = missing_value endif @@ -909,7 +910,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do k=1,kd do j=js,je do i=is,ie - tr_z(i,j,k) = data_in(i,j,k) * conversion + tr_z(i,j,k) = data_in(i,j,k) * scale if (ans_date >= 20190101) mask_z(i,j,k) = 1. if (abs(tr_z(i,j,k)-missing_value) < abs(roundoff*missing_value)) mask_z(i,j,k) = 0. enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 62438cbc7f..c5b57f3d57 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2483,8 +2483,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real :: PI_180 ! for conversion from degrees to radians [radian degree-1] real :: Hmix_default ! The default initial mixed layer depth [Z ~> m]. real :: Hmix_depth ! The mixed layer depth in the initial condition [Z ~> m]. - real :: missing_value_temp ! The missing value in the input temperature field - real :: missing_value_salt ! The missing value in the input salinity field + real :: missing_value_temp ! The missing value in the input temperature field [C ~> degC] + real :: missing_value_salt ! The missing value in the input salinity field [S ~> ppt] + real :: tol_temp ! The tolerance for changes in temperature during the horizontal + ! interpolation from an input dataset [C ~> degC] + real :: tol_sal ! The tolerance for changes in salinity during the horizontal + ! interpolation from an input dataset [S ~> ppt] logical :: correct_thickness real :: h_tolerance ! A parameter that controls the tolerance when adjusting the ! thickness to fit the bathymetry [Z ~> m]. @@ -2494,19 +2498,19 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just logical :: adjust_temperature = .true. ! fit t/s to target densities real :: temp_land_fill ! A temperature value to use for land points [C ~> degC] real :: salt_land_fill ! A salinity value to use for land points [C ~> degC] - logical :: reentrant_x, tripolar_n ! data arrays - real, dimension(:), allocatable :: z_edges_in, z_in ! Interface heights [Z ~> m] - real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] + real, dimension(:), allocatable :: z_edges_in ! Input data interface heights or depths [Z ~> m] + real, dimension(:), allocatable :: z_in ! Input data cell heights or depths [Z ~> m] + real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] real, dimension(:,:,:), allocatable, target :: temp_z ! Input temperatures [C ~> degC] real, dimension(:,:,:), allocatable, target :: salt_z ! Input salinities [S ~> ppt] real, dimension(:,:,:), allocatable, target :: mask_z ! 1 for valid data points [nondim] - real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] + real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zi ! Interface heights [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G)) :: Z_bottom ! The (usually negative) height of the seafloor - ! relative to the surface [Z ~> m]. - integer, dimension(SZI_(G),SZJ_(G)) :: nlevs ! The number of levels in each column with valid data + real, dimension(SZI_(G),SZJ_(G)) :: Z_bottom ! The (usually negative) height of the seafloor + ! relative to the surface [Z ~> m]. + integer, dimension(SZI_(G),SZJ_(G)) :: nlevs ! The number of levels in each column with valid data real, dimension(SZI_(G)) :: press ! Pressures [R L2 T-2 ~> Pa]. ! Local variables for ALE remapping @@ -2569,9 +2573,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just eos => tv%eqn_of_state - reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x, default=.true.) - tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mdl, "TEMP_SALT_Z_INIT_FILE", filename, & "The name of the z-space input file used to initialize "//& "temperatures (T) and salinities (S). If T and S are not "//& @@ -2701,6 +2702,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just !### These hard-coded constants should be made into runtime parameters temp_land_fill = 0.0*US%degC_to_C salt_land_fill = 35.0*US%ppt_to_S + tol_temp = 1.0e-3*US%degC_to_C + tol_sal = 1.0e-3*US%ppt_to_S eps_z = GV%Angstrom_Z eps_rho = 1.0e-10*US%kg_m3_to_R @@ -2720,15 +2723,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var, US%degC_to_C, 1, & - G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date, & - ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%degC_to_C) + call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1, & + G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, & + scale=US%degC_to_C, homogenize=homogenize, m_to_Z=US%m_to_Z, & + answer_date=hor_regrid_answer_date, ongrid=pre_gridded, tr_iter_tol=tol_temp) - call horiz_interp_and_extrap_tracer(sfilename, salin_var, US%ppt_to_S, 1, & - G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date, & - ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%ppt_to_S) + call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1, & + G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, & + scale=US%ppt_to_S, homogenize=homogenize, m_to_Z=US%m_to_Z, & + answer_date=hor_regrid_answer_date, ongrid=pre_gridded, tr_iter_tol=tol_sal) kd = size(z_in,1) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 04c03a5b43..7c62ea496e 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -41,11 +41,12 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized + real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized [CU ~> conc] type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename character(len=*), intent(in) :: src_var_nam !< variable name in file - real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion + real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion, + !! often used for rescaling into model units [CU conc-1 ~> 1] integer, optional, intent(in) :: src_var_record !< record to read for multiple time-level files logical, optional, intent(in) :: homogenize !< optionally homogenize to mean value logical, optional, intent(in) :: useALEremapping !< to remap or not (optional) @@ -53,11 +54,11 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ character(len=*), optional, intent(in) :: src_var_gridspec !< Source variable name in a gridspec file. !! This is not implemented yet. ! Local variables - real :: land_fill = 0.0 - real :: convert + real :: land_fill = 0.0 ! A value to use to replace missing values [CU ~> conc] + real :: convert ! A conversion factor into the model's internal units [CU conc-1 ~> 1] integer :: recnum character(len=64) :: remapScheme - logical :: homog,useALE + logical :: homog, useALE ! This include declares and sets the variable "version". # include "version_variable.h" @@ -66,8 +67,12 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ integer :: is, ie, js, je, nz ! compute domain indices integer :: isd, ied, jsd, jed ! data domain indices integer :: i, j, k, kd - real, allocatable, dimension(:,:,:), target :: tr_z, mask_z - real, allocatable, dimension(:), target :: z_edges_in, z_in + real, allocatable, dimension(:,:,:), target :: tr_z ! Tracer array on the horizontal model grid + ! and input-file vertical levels [CU ~> conc] + real, allocatable, dimension(:,:,:), target :: mask_z ! Missing value mask on the horizontal model grid + ! and input-file vertical levels [nondim] + real, allocatable, dimension(:), target :: z_edges_in ! Cell edge depths for input data [Z ~> m] + real, allocatable, dimension(:), target :: z_in ! Cell center depths for input data [Z ~> m] ! Local variables for ALE remapping real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses [H ~> m or kg m-2]. @@ -75,8 +80,8 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays - real :: missing_value - integer :: nPoints + real :: missing_value ! A value indicating that there is no valid input data at this point [CU ~> conc] + integer :: nPoints ! The number of valid input data points in a column integer :: id_clock_routine, id_clock_ALE integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -94,7 +99,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! for horizontal regridding. Values below 20190101 recover the ! answers from 2018, while higher values use expressions that have ! been rearranged for rotational invariance. - logical :: reentrant_x, tripolar_n id_clock_routine = cpu_clock_id('(Initialize tracer from Z)', grain=CLOCK_ROUTINE) id_clock_ALE = cpu_clock_id('(Initialize tracer from Z) ALE', grain=CLOCK_LOOP) @@ -153,22 +157,17 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) - ! These are model grid properties, but being applied to the data grid for now. - ! need to revisit this (mjh) - reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) - tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - if (PRESENT(homogenize)) homog=homogenize if (PRESENT(useALEremapping)) useALE=useALEremapping if (PRESENT(remappingScheme)) remapScheme=remappingScheme - recnum=1 + recnum = 1 if (PRESENT(src_var_record)) recnum = src_var_record - convert=1.0 + convert = 1.0 if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion - call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & - G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & - homog, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(src_file, src_var_nam, recnum, & + G, tr_z, mask_z, z_in, z_edges_in, missing_value, & + scale=convert, homogenize=homog, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date) kd = size(z_edges_in,1)-1 call pass_var(tr_z,G%Domain) @@ -221,7 +220,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie if (tr(i,j,k) == missing_value) then - tr(i,j,k)=land_fill + tr(i,j,k) = land_fill endif enddo ; enddo ; enddo diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 2a1a96168a..4ad11592f9 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -559,19 +559,22 @@ subroutine get_bias_correction_tracer(Time, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ODA_CS), pointer :: CS !< ocean DA control structure - integer :: i,j,k + ! Local variables real, allocatable, dimension(:,:,:) :: T_bias ! Temperature biases [C ~> degC] real, allocatable, dimension(:,:,:) :: S_bias ! Salinity biases [C ~> degC] - real, allocatable, dimension(:,:,:) :: mask_z - real, allocatable, dimension(:), target :: z_in, z_edges_in - real :: missing_value - integer,dimension(3) :: fld_sz + real, allocatable, dimension(:,:,:) :: mask_z ! Missing value mask on the horizontal model grid + ! and input-file vertical levels [nondim] + real, allocatable, dimension(:), target :: z_in ! Cell center depths for input data [Z ~> m] + real, allocatable, dimension(:), target :: z_edges_in ! Cell edge depths for input data [Z ~> m] + real :: missing_value ! A value indicating that there is no valid input data at this point [CU ~> conc] + integer, dimension(3) :: fld_sz + integer :: i,j,k call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id, Time, US%degC_to_C, CS%G, T_bias, & - mask_z, z_in, z_edges_in, missing_value, .true., .false., .false., .true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id, Time, US%ppt_to_S, CS%G, S_bias, & - mask_z, z_in, z_edges_in, missing_value, .true., .false., .false., .true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id, Time, CS%G, T_bias, & + mask_z, z_in, z_edges_in, missing_value, scale=US%degC_to_C, spongeOngrid=.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id, Time, CS%G, S_bias, & + mask_z, z_in, z_edges_in, missing_value, scale=US%ppt_to_S, spongeOngrid=.true.) ! This should be replaced to use mask_z instead of the following lines ! which are intended to zero land values using an arbitrary limit. diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 9f5241bb9a..a121b05d30 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -133,9 +133,6 @@ module MOM_ALE_sponge logical :: time_varying_sponges !< True if using newer sponge code logical :: spongeDataOngrid !< True if the sponge data are on the model horizontal grid - logical :: reentrant_x !< grid is reentrant in the x direction - logical :: tripolar_N !< grid is folded at its north edge - !>@{ Diagnostic IDs integer, dimension(MAX_FIELDS_) :: id_sp_tendency !< Diagnostic ids for tracers !! tendency due to sponges @@ -257,11 +254,6 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "while later versions add parentheses for rotational symmetry. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) - call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & - "If true, the domain is zonally reentrant.", default=.true.) - call get_param(param_file, mdl, "TRIPOLAR_N", CS%tripolar_N, & - "Use tripolar connectivity at the northern edge of the "//& - "domain. With TRIPOLAR_N, NIGLOBAL must be even.", default=.false.) CS%time_varying_sponges = .false. CS%nz = GV%ke @@ -551,11 +543,6 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "When defined, the incoming sponge data are "//& "assumed to be on the model grid " , & default=.false.) - call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & - "If true, the domain is zonally reentrant.", default=.true.) - call get_param(param_file, mdl, "TRIPOLAR_N", CS%tripolar_N, & - "Use tripolar connectivity at the northern edge of the "//& - "domain. With TRIPOLAR_N, NIGLOBAL must be even.", default=.false.) CS%time_varying_sponges = .true. CS%nz = GV%ke @@ -985,10 +972,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data - call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, CS%Ref_val(m)%scale, G, sp_val, & - mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & - spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & - answer_date=CS%hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, & + scale=CS%Ref_val(m)%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & + answer_date=CS%hor_regrid_answer_date) allocate( hsrc(nz_data) ) allocate( tmpT1d(nz_data) ) do c=1,CS%num_col @@ -1069,10 +1056,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, CS%Ref_val_u%scale, G, sp_val, & - mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & - spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answer_date=CS%hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, & + scale=CS%Ref_val_u%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & + answer_date=CS%hor_regrid_answer_date) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc-1, G%jsc:G%jec, :) = 0. @@ -1118,10 +1105,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, CS%Ref_val_v%scale, G, sp_val, & - mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & - spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answer_date=CS%hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, & + scale=CS%Ref_val_v%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& + answer_date=CS%hor_regrid_answer_date) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc:G%iec, G%jsc-1, :) = 0. mask_z(G%isc:G%iec, G%jec+1, :) = 0. From 31cb51737037478aefcfa45c5c2a8688df3f5b23 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 19 Dec 2022 18:09:15 -0500 Subject: [PATCH 096/213] +Add 7 runtime variables for hard-coded tolerances Added the runtime variables DZ_BOTTOM_TOLERANCE, TRIM_IC_Z_TOLERANCE, DENSITY_INTERP_TOLERANCE, HORIZ_INTERP_TOL_TEMP, HORIZ_INTERP_TOL_SALIN, LAND_FILL_TEMP and LAND_FILL_SALIN to replace hard-coded dimensional constants in the routines MOM_temp_salt_initialize_from_Z, trim_for_ice, and initialize_thickness_from_file in MOM_state_initialization.F90. By default, all answers are bitwise identical, but there are new entries in the MOM_parameter_doc files for some configurations. --- .../MOM_state_initialization.F90 | 75 ++++++++++++++----- 1 file changed, 55 insertions(+), 20 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index c5b57f3d57..5af360d775 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -691,7 +691,9 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f ! them to units of m or correct sign conventions to positive upward [various] real :: h_tolerance ! A parameter that controls the tolerance when adjusting the ! thickness to fit the bathymetry [Z ~> m]. - integer :: inconsistent = 0 + real :: tol_dz_bot ! A tolerance for detecting inconsistent bottom depths when + ! correct_thickness is false [Z ~> m] + integer :: inconsistent ! The total number of cells with in consistent topography and layer thicknesses. logical :: correct_thickness character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path @@ -738,6 +740,11 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) endif + call get_param(param_file, mdl, "DZ_BOTTOM_TOLERANCE", tol_dz_bot, & + "A tolerance for detecting inconsist topography and input layer "//& + "ticknesses when ADJUST_THICKNESS is false.", & + units="m", default=1.0, scale=US%m_to_Z, & + do_not_log=(just_read.or.correct_thickness)) call get_param(param_file, mdl, "INTERFACE_IC_VAR", eta_var, & "The variable name for initial conditions for interface heights "//& "relative to mean sea level, positive upward unless otherwise rescaled.", & @@ -762,8 +769,9 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f endif enddo ; enddo ; enddo + inconsistent = 0 do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + depth_tot(i,j)) > 1.0*US%m_to_Z) & + if (abs(eta(i,j,nz+1) + depth_tot(i,j)) > tol_dz_bot) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -1188,6 +1196,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor ! A file-dependent scaling factor for the input pressure. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. + real :: z_tolerance ! The tolerance with which to find the depth matching a specified pressure [Z ~> m]. integer :: i, j, k integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -1217,6 +1226,11 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & units='m', default=1.e-3, scale=US%m_to_Z, do_not_log=just_read) + call get_param(PF, mdl, "TRIM_IC_Z_TOLERANCE", z_tolerance, & + "The tolerance with which to find the depth matching the specified "//& + "surface pressure with TRIM_IC_FOR_P_SURF.", & + units="m", default=1.0e-5, scale=US%m_to_Z, do_not_log=just_read) + call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) @@ -1270,7 +1284,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) call cut_off_column_top(GV%ke, tv, GV, US, GV%g_Earth, G%bathyT(i,j)+G%Z_ref, & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & - z_tol=1.0e-5*US%m_to_Z, remap_answer_date=remap_answer_date) + z_tol=z_tolerance, remap_answer_date=remap_answer_date) enddo ; enddo end subroutine trim_for_ice @@ -2476,7 +2490,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just integer :: i, j, k, ks integer :: nkml ! The number of layers in the mixed layer. - integer :: kd, inconsistent + integer :: inconsistent ! The total number of cells with in consistent topography and layer thicknesses. + integer :: kd ! The number of levels in the input data integer :: nkd ! number of levels to use for regridding input arrays real :: eps_Z ! A negligibly thin layer thickness [Z ~> m]. real :: eps_rho ! A negligibly small density difference [R ~> kg m-3]. @@ -2489,9 +2504,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! interpolation from an input dataset [C ~> degC] real :: tol_sal ! The tolerance for changes in salinity during the horizontal ! interpolation from an input dataset [S ~> ppt] - logical :: correct_thickness + logical :: correct_thickness ! If true, correct the column thicknesses to match the topography real :: h_tolerance ! A parameter that controls the tolerance when adjusting the ! thickness to fit the bathymetry [Z ~> m]. + real :: tol_dz_bot ! A tolerance for detecting inconsistent bottom depths when + ! correct_thickness is false [Z ~> m] character(len=40) :: potemp_var, salin_var integer, parameter :: niter=10 ! number of iterations for t/s adjustment to layer density @@ -2662,12 +2679,16 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If true, all mass below the bottom removed if the "//& "topography is shallower than the thickness input file "//& "would indicate.", default=.false., do_not_log=just_read) - if (correct_thickness) then - call get_param(PF, mdl, "THICKNESS_TOLERANCE", h_tolerance, & + call get_param(PF, mdl, "THICKNESS_TOLERANCE", h_tolerance, & "A parameter that controls the tolerance when adjusting the "//& "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & - units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) - endif + units="m", default=0.1, scale=US%m_to_Z, & + do_not_log=(just_read.or..not.correct_thickness)) + call get_param(PF, mdl, "DZ_BOTTOM_TOLERANCE", tol_dz_bot, & + "A tolerance for detecting inconsist topography and input layer "//& + "ticknesses when ADJUST_THICKNESS is false.", & + units="m", default=1.0, scale=US%m_to_Z, & + do_not_log=(just_read.or.correct_thickness)) call get_param(PF, mdl, "FIT_TO_TARGET_DENSITY_IC", adjust_temperature, & "If true, all the interior layers are adjusted to "//& @@ -2686,27 +2707,41 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "The mixed layer depth in the initial conditions when Z_INIT_SEPARATE_MIXED_LAYER "//& "is set to true.", units="m", default=US%Z_to_m*Hmix_default, scale=US%m_to_Z, & do_not_log=(just_read .or. .not.separate_mixed_layer)) + ! Reusing MINIMUM_DEPTH for the default mixed layer depth may be a strange choice, but + ! it reproduces previous answers. + call get_param(PF, mdl, "DENSITY_INTERP_TOLERANCE", eps_rho, & + "A small density tolerance used when finding depths in a density profile.", & + units="kg m-3", default=1.0e-10, scale=US%kg_m3_to_R, & + do_not_log=useALEremapping.or.just_read) call get_param(PF, mdl, "LAYER_Z_INIT_IC_EXTRAP_BUG", density_extrap_bug, & "If true use an expression with a vertical indexing bug for extrapolating the "//& "densities at the bottom of unstable profiles from data when finding the "//& "initial interface locations in layered mode from a dataset of T and S.", & default=.false., do_not_log=just_read) - ! Reusing MINIMUM_DEPTH for the default mixed layer depth may be a strange choice, but - ! it reproduces previous answers. endif + call get_param(PF, mdl, "LAND_FILL_TEMP", temp_land_fill, & + "A value to use to fill in ocean temperatures on land points.", & + units="degC", default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "LAND_FILL_SALIN", salt_land_fill, & + "A value to use to fill in ocean salinities on land points.", & + units="1e-3", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "HORIZ_INTERP_TOL_TEMP", tol_temp, & + "The tolerance in temperature changes between iterations when interpolating "//& + "ifrom an nput dataset using horiz_interp_and_extrap_tracer. This routine "//& + "converges slowly, so an overly small tolerance can get expensive.", & + units="degC", default=1.0e-3, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "HORIZ_INTERP_TOL_SALIN", tol_sal, & + "The tolerance in salinity changes between iterations when interpolating "//& + "ifrom an nput dataset using horiz_interp_and_extrap_tracer. This routine "//& + "converges slowly, so an overly small tolerance can get expensive.", & + units="1e-3", default=1.0e-3, scale=US%ppt_to_S, do_not_log=just_read) + if (just_read) then call cpu_clock_end(id_clock_routine) return ! All run-time parameters have been read, so return. endif - !### These hard-coded constants should be made into runtime parameters - temp_land_fill = 0.0*US%degC_to_C - salt_land_fill = 35.0*US%ppt_to_S - tol_temp = 1.0e-3*US%degC_to_C - tol_sal = 1.0e-3*US%ppt_to_S - eps_z = GV%Angstrom_Z - eps_rho = 1.0e-10*US%kg_m3_to_R ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the @@ -2877,9 +2912,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif enddo ; enddo ; enddo - inconsistent=0 + inconsistent = 0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) - Z_bottom(i,j)) > 1.0*US%m_to_Z) & + if (abs(zi(i,j,nz+1) - Z_bottom(i,j)) > tol_dz_bot) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) From 39f45f05400c6280cae5987317715cd3dcd4d965 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 19 Dec 2022 18:10:30 -0500 Subject: [PATCH 097/213] Document the units of variables in MOM_ALE_sponge Added to the comments describing a number of the internal variables in the MOM_ALE_sponge code, although given that much of this works on variables with arbitrary units, many of the units descriptions have to be simply [various]. All answers and output are bitwise identical. --- .../vertical/MOM_ALE_sponge.F90 | 78 +++++++++++-------- 1 file changed, 44 insertions(+), 34 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index a121b05d30..740c42f16a 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -69,8 +69,8 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field. integer :: num_tlevs !< The number of time records contained in the file - real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data. - real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid. + real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data [various] + real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid [H ~> m or kg m-2] end type p3d !> A structure for creating arrays of pointers to 2D arrays with extra gridding information @@ -79,8 +79,8 @@ module MOM_ALE_sponge integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file real :: scale = 1.0 !< A multiplicative factor by which to rescale input data - real, dimension(:,:), pointer :: p => NULL() !< pointer the data. - real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. + real, dimension(:,:), pointer :: p => NULL() !< pointer to the data [various] + real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid [H ~> m or kg m-2] character(len=:), allocatable :: name !< The name of the input field character(len=:), allocatable :: long_name !< The long name of the input field character(len=:), allocatable :: unit !< The unit of the input field @@ -687,9 +687,9 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, & type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out). real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & intent(in) :: sp_val !< Field to be used in the sponge, it can have an - !! arbitrary number of layers. + !! arbitrary number of layers [various] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: f_ptr !< Pointer to the field to be damped + target, intent(in) :: f_ptr !< Pointer to the field to be damped [various] character(len=*), intent(in) :: sp_name !< The name of the tracer field character(len=*), optional, & intent(in) :: sp_long_name !< The long name of the tracer field @@ -698,9 +698,10 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, & intent(in) :: sp_unit !< The unit of the tracer field !! if not given, use the none real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. The default is 1. + !! contributions due to dimensional rescaling [various ~> 1]. + !! The default is 1. - real :: scale_fac ! A factor by which to scale sp_val before storing it. + real :: scale_fac ! A factor by which to scale sp_val before storing it [various ~> 1] integer :: k, col character(len=256) :: mesg ! String for error messages character(len=256) :: long_name ! The long name of the tracer field @@ -749,7 +750,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in) [various]. type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out). character(len=*), intent(in) :: sp_name !< The name of the tracer field character(len=*), optional, & @@ -759,7 +760,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, intent(in) :: sp_unit !< The unit of the tracer field !! if not given, use 'none' real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. The default is 1. + !! contributions due to dimensional rescaling [various ~> 1]. + !! The default is 1. ! Local variables integer :: isd, ied, jsd, jed @@ -824,9 +826,10 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u-field to be damped [L T-1 ~> m s-1] real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v-field to be damped [L T-1 ~> m s-1] real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. The default is 1. + !! contributions due to dimensional rescaling [various ~> 1]. + !! The default is 1. - real :: scale_fac + real :: scale_fac ! A dimensional rescaling factor [various ~> 1] integer :: k, col if (.not.associated(CS)) return @@ -867,8 +870,9 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u-field to be damped [L T-1 ~> m s-1] real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v-field to be damped [L T-1 ~> m s-1] real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. For varying - !! velocities the default is the same using US%m_s_to_L_T. + !! contributions due to dimensional rescaling, often in + !! [L s T-1 m-1 ~> 1]. For varying velocities the + !! default is the same as using US%m_s_to_L_T. ! Local variables logical :: override @@ -931,16 +935,19 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim]. - real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid - real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid + real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid [various] + real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid [various] real, dimension(SZK_(GV)) :: h_col ! A column of thicknesses at h, u or v points [H ~> m or kg m-2] - real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields - real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts - real, allocatable, dimension(:,:,:) :: mask_u ! A temporary array for field mask at u pts - real, allocatable, dimension(:,:,:) :: mask_v ! A temporary array for field mask at v pts - real, allocatable, dimension(:,:,:) :: tmp !< A temporary array for thermodynamic sponge tendency diagnostics, + real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields [various] + real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts [nondim] + real, allocatable, dimension(:,:,:) :: mask_u ! A temporary array for field mask at u pts [nondim] + real, allocatable, dimension(:,:,:) :: mask_v ! A temporary array for field mask at v pts [nondim] + real, allocatable, dimension(:,:,:) :: tmp !< A temporary array for thermodynamic sponge tendency + !! diagnostics [various] real, allocatable, dimension(:,:,:) :: tmp_u !< A temporary array for u sponge acceleration diagnostics + !! first in [L T-1 ~> m s-1] then in [L T-2 ~> m s-2] real, allocatable, dimension(:,:,:) :: tmp_v !< A temporary array for v sponge acceleration diagnostics + !! first in [L T-1 ~> m s-1] then in [L T-2 ~> m s-2] real, dimension(:), allocatable :: hsrc ! Source thicknesses [Z ~> m]. ! Local variables for ALE remapping real, dimension(:), allocatable :: tmpT1d @@ -948,12 +955,12 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real, allocatable, dimension(:), target :: z_in ! The depths (positive downward) in the input file [Z ~> m] real, allocatable, dimension(:), target :: z_edges_in ! The depths (positive downward) of the ! edges in the input file [Z ~> m] - real :: missing_value + real :: missing_value ! The missing value in the input data field [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] real :: zTopOfCell, zBottomOfCell ! Interface heights (positive upward) in the input dataset [Z ~> m]. - real :: sp_val_u ! Interpolation of sp_val to u-points - real :: sp_val_v ! Interpolation of sp_val to v-points + real :: sp_val_u ! Interpolation of sp_val to u-points, often a velocity in [L T-1 ~> m s-1] + real :: sp_val_v ! Interpolation of sp_val to v-points, often a velocity in [L T-1 ~> m s-1] integer :: nPoints is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -982,7 +989,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) i = CS%col_i(c) ; j = CS%col_j(c) CS%Ref_val(m)%p(1:nz_data,c) = sp_val(i,j,1:nz_data) ! Build the source grid - zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 + zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 ; hsrc(:) = 0.0 ; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(c),CS%col_j(c),k) == 1.0) then zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(CS%col_i(c),CS%col_j(c)) ) @@ -1012,7 +1019,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) enddo endif - tmp_val1(:)=0.0;h_col(:)=0.0 + tmp_val1(:) = 0.0 ; h_col(:) = 0.0 do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data allocate(tmp_val2(CS%Ref_val(m)%nz_data)) @@ -1086,7 +1093,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) CS%Ref_val_u%p(1:nz_data,c) = 0.0 endif ! Build the source grid - zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0 + zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 ; hsrc(:) = 0.0 do k=1,nz_data if (mask_u(i,j,k) == 1.0) then zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(i,j) ) @@ -1134,7 +1141,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) CS%Ref_val_v%p(1:nz_data,c) = 0.0 endif ! Build the source grid - zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0 + zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 ; hsrc(:) = 0.0 do k=1,nz_data if (mask_v(i,j,k) == 1.0) then zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(i,j) ) @@ -1241,10 +1248,13 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) ! 3. Call initialize_ALE_sponge using new grid and rotated Iresttime(:,:) ! All the index adjustment should follow from the Iresttime rotation - real, dimension(:,:), allocatable :: Iresttime_in, Iresttime - real, dimension(:,:,:), allocatable :: data_h_in, data_h - real, dimension(:,:,:), allocatable :: sp_val_in, sp_val - real, dimension(:,:,:), pointer :: sp_ptr => NULL() + real, dimension(:,:), allocatable :: Iresttime_in ! Restoring rate on the input sponges [T-1 ~> s-1] + real, dimension(:,:), allocatable :: Iresttime ! Restoring rate on the output sponges [T-1 ~> s-1] + real, dimension(:,:,:), allocatable :: data_h_in ! Grid for the input sponges [H ~> m or kg m-2] + real, dimension(:,:,:), allocatable :: data_h ! Grid for the output sponges [H ~> m or kg m-2] + real, dimension(:,:,:), allocatable :: sp_val_in ! Target data for the input sponges [various] + real, dimension(:,:,:), allocatable :: sp_val ! Target data for the output sponges [various] + real, dimension(:,:,:), pointer :: sp_ptr => NULL() ! Target data for the input sponges [various] integer :: c, c_i, c_j integer :: k, nz_data integer :: n @@ -1365,11 +1375,11 @@ end subroutine rotate_ALE_sponge subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) type(ALE_sponge_CS), intent(inout) :: sponge !< ALE sponge control struct real, dimension(:,:,:), & - target, intent(in) :: p_old !< The previous array of target values + target, intent(in) :: p_old !< The previous array of target values [various] type(ocean_grid_type), intent(in) :: G !< The updated ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: p_new !< The new array of target values + target, intent(in) :: p_new !< The new array of target values [various] integer :: n From 19e268dd8ad5e8b04c6c207f332e86628100b74c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 20 Dec 2022 15:32:55 -0500 Subject: [PATCH 098/213] +Add 11 runtime params for determine_temperature Added 11 new runtime parameters (DETERMINE_TEMP_ADJUST_T_AND_S, DETERMINE_TEMP_T_MIN, DETERMINE_TEMP_T_MAX, DETERMINE_TEMP_S_MIN, DETERMINE_TEMP_S_MAX, DETERMINE_TEMP_T_TOLERANCE, DETERMINE_TEMP_S_TOLERANCE, DETERMINE_TEMP_RHO_TOLERANCE, DETERMINE_TEMP_DT_DS_WEIGHT, DETERMINE_TEMP_T_ADJ_RANGE, and DETERMINE_TEMP_S_ADJ_RANGE) to replace hard coded dimensional parameters used in the routine determine_temperature. This change also requires that a param_file_type argument and the logical argument just_read are passed to determine temperature. By default, all answers are bitwise identical but there are up to 10 new entries in the MOM_parameter_doc files for some layer-mode configurations with INIT_LAYERS_FROM_Z_FILE and FIT_TO_TARGET_DENSITY_IC set to true. --- .../MOM_state_initialization.F90 | 8 +- src/tracer/MOM_tracer_Z_init.F90 | 84 ++++++++++++++----- 2 files changed, 70 insertions(+), 22 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 5af360d775..14459f7d0a 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2737,6 +2737,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just units="1e-3", default=1.0e-3, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) then + if ((.not.useALEremapping) .and. adjust_temperature) & + ! This call is just here to read and log the determine_temperature parameters + call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), eos, tv%P_Ref, 0, & + h, 0, G, GV, US, PF, just_read=.true.) call cpu_clock_end(id_clock_routine) return ! All run-time parameters have been read, so return. endif @@ -2957,8 +2961,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just if (adjust_temperature) then ! Finally adjust to target density ks = 1 ; if (separate_mixed_layer) ks = GV%nk_rho_varies + 1 - call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), tv%P_Ref, niter, & - h, ks, G, GV, US, eos) + call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), eos, tv%P_Ref, niter, & + h, ks, G, GV, US, PF, just_read) endif endif ! useALEremapping diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 85a858b8df..d887f5f3be 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -4,7 +4,7 @@ module MOM_tracer_Z_init ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe -! use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : MOM_read_data, get_var_sizes, read_attribute, read_variable use MOM_io, only : open_file_to_read, close_file_to_read @@ -556,8 +556,8 @@ end function find_limited_slope !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess -subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, GV, US, & - EOS, h_massless) +subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_start, G, GV, US, & + PF, just_read, h_massless) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -565,6 +565,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: salt !< salinity [S ~> ppt] real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. + type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) @@ -572,7 +573,10 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, intent(in) :: h !< layer thickness, used only to avoid working on !! massless layers [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure + type(param_file_type), intent(in) :: PF !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. real, optional, intent(in) :: h_massless !< A threshold below which a layer is !! determined to be massless [H ~> m or kg m-2] @@ -600,29 +604,69 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, ! when old_fit is true [C ~> degC] real :: max_s_adj ! The largest permitted salinity changes with each iteration ! when old_fit is true [S ~> ppt] - logical :: adjust_salt, old_fit + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "determine_temperature" ! This subroutine's name. + logical :: adjust_salt, fit_together integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! These hard coded parameters need to be set properly. - S_min = 0.5*US%ppt_to_S ; S_max = 65.0*US%ppt_to_S - T_max = 31.0*US%degC_to_C ; T_min = -2.0*US%degC_to_C - max_t_adj = 1.0*US%degC_to_C - max_s_adj = 0.5*US%ppt_to_S - tol_T = 1.0e-4*US%degC_to_C - tol_S = 1.0e-4*US%ppt_to_S - tol_rho = 1.0e-4*US%kg_m3_to_R - old_fit = .true. ! reproduces siena behavior + ! ### The algorithms of determine_temperature subroutine needs to be reexamined. - dT_dS_gauge = 10.0*US%degC_to_C*US%S_to_ppt ! 10 degC is weighted equivalently to 1 ppt. - ! ### The whole determine_temperature subroutine needs to be reexamined, both the algorithms - ! and the extensive use of hard-coded dimensional parameters. + call log_version(PF, mdl, version, "") - ! We will switch to the newer method which simultaneously adjusts + ! We should switch the default to the newer method which simultaneously adjusts ! temp and salt based on the ratio of the thermal and haline coefficients, once it is tested. + call get_param(PF, mdl, "DETERMINE_TEMP_ADJUST_T_AND_S", fit_together, & + "If true, simltaneously adjust the estimates of the temperature and salinity "//& + "based on the ratio of the thermal and haline coefficients. Otherwise try to "//& + "match the density by only adjusting temperatures within a maximum range before "//& + "revising estimates of the salinity.", default=.false., do_not_log=just_read) + ! These hard coded parameters need to be set properly. + call get_param(PF, mdl, "DETERMINE_TEMP_T_MIN", T_min, & + "The minimum temperature that can be found by determine_temperature.", & + units="degC", default=-2.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_T_MAX", T_max, & + "The maximum temperature that can be found by determine_temperature.", & + units="degC", default=31.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_MIN", S_min, & + "The minimum salinity that can be found by determine_temperature.", & + units="1e-3", default=0.5, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_MAX", S_max, & + "The maximum salinity that can be found by determine_temperature.", & + units="1e-3", default=65.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_T_TOLERANCE", tol_T, & + "The convergence tolerance for temperature in determine_temperature.", & + units="degC", default=1.0e-4, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_TOLERANCE", tol_S, & + "The convergence tolerance for temperature in determine_temperature.", & + units="1e-3", default=1.0e-4, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_RHO_TOLERANCE", tol_rho, & + "The convergence tolerance for density in determine_temperature.", & + units="kg m-3", default=1.0e-4, scale=US%kg_m3_to_R, do_not_log=just_read) + if (fit_together) then + ! By default 10 degC is weighted equivalently to 1 ppt when minimizing changes. + call get_param(PF, mdl, "DETERMINE_TEMP_DT_DS_WEIGHT", dT_dS_gauge, & + "When extrapolating T & S to match the layer target densities, this "//& + "factor (in deg C / PSU) is combined with the derivatives of density "//& + "with T & S to determine what direction is orthogonal to density contours. "//& + "It could be based on a typical value of (dR/dS) / (dR/dT) in oceanic profiles.", & + units="degC PSU-1", default=10.0, scale=US%degC_to_C*US%S_to_ppt) + else + call get_param(PF, mdl, "DETERMINE_TEMP_T_ADJ_RANGE", max_t_adj, & + "The maximum amount by which the initial layer temperatures can be "//& + "modified in determine_temperature.", & + units="degC", default=1.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_ADJ_RANGE", max_S_adj, & + "The maximum amount by which the initial layer salinities can be "//& + "modified in determine_temperature.", & + units="1e-3", default=0.5, scale=US%ppt_to_S, do_not_log=just_read) + endif + + if (just_read) return ! All run-time parameters have been read, so return. press(:) = p_ref EOSdom(:) = EOS_domain(G%HI) @@ -643,7 +687,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, do k=k_start,nz ; do i=is,ie ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln) then if (abs(rho(i,k)-R_tgt(k))>tol_rho) then - if (old_fit) then + if (.not.fit_together) then dT(i,k) = max(min((R_tgt(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) else @@ -662,7 +706,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, endif enddo iter_loop - if (adjust_salt .and. old_fit) then ; do itt = 1,niter + if (adjust_salt .and. .not.fit_together) then ; do itt = 1,niter do k=1,nz call calculate_density(T(:,k), S(:,k), press, rho(:,k), EOS, EOSdom ) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & From e1982964b0dd068c363a1ff4f1743f2ca5440152 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 20 Dec 2022 15:36:17 -0500 Subject: [PATCH 099/213] +Add 2 runtime params for ice shelf temperatures Added the new runtime parameters INFLOW_SHELF_TEMPERATURE and MISSING_SHELF_TEMPERATURE to the ice_shelf_dynamics module to replace hard coded ice shelf temperatures. White space was also added around "=" in a number of places in this same module to align with the MOM6 style guide. By default, all answers are bitwise identical, but there are new entries in some MOM_parameter_doc files for cases that use the ice shelf code with DYNAMIC_SHELF_MASS. --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 99 ++++++++++++++---------- 1 file changed, 56 insertions(+), 43 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 2ed64359cb..552216f41d 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -147,7 +147,7 @@ module MOM_ice_shelf_dynamics logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. - + real :: T_shelf_missing !< An ice shelf temperature to use where there is no ice shelf [degC ~> C] real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that !! determines when to stop the conjugate gradient iterations [nondim]. real :: nonlinear_tolerance !< The fractional nonlinear tolerance, relative to the initial error, @@ -234,6 +234,8 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + ! Local variables + real :: T_shelf_missing ! An ice shelf temperature to use where there is no ice shelf [degC ~> C] logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -260,9 +262,12 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) endif if (active_shelf_dynamics) then + call get_param(param_file, mdl, "MISSING_SHELF_TEMPERATURE", T_shelf_missing, & + "An ice shelf temperature to use where there is no ice shelf.",& + units="degC", default=-10.0, scale=US%degC_to_C, do_not_log=.true.) allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) - allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0*US%degC_to_C ) ! [C ~> degC] + allocate( CS%t_shelf(isd:ied,jsd:jed), source=T_shelf_missing ) ! [C ~> degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3 s-1] allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) ! [R L2 T-2 ~> Pa] @@ -329,6 +334,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! a restart file to the internal representation in this run. real :: vel_rescale ! A rescaling factor for horizontal velocities from the representation ! in a restart file to the internal representation in this run. + real :: T_shelf_bdry ! A default ice shelf temperature to use for ice flowing + ! in through open boundaries [C ~> degC] !This include declares and sets the variable "version". # include "version_variable.h" character(len=200) :: IC_file,filename,inputdir @@ -438,7 +445,13 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ "if CONSTANT a constant value (for debugging).", & default="MODEL") + call get_param(param_file, mdl, "INFLOW_SHELF_TEMPERATURE", T_shelf_bdry, & + "A default ice shelf temperature to use for ice flowing in through "//& + "open boundaries.", units="degC", default=-15.0, scale=US%degC_to_C) endif + call get_param(param_file, mdl, "MISSING_SHELF_TEMPERATURE", CS%T_shelf_missing, & + "An ice shelf temperature to use where there is no ice shelf.",& + units="degC", default=-10.0, scale=US%degC_to_C) call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& units="m", default=0.0, scale=US%m_to_Z) @@ -447,7 +460,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! previously allocated for registration for restarts. if (active_shelf_dynamics) then - allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=-15.0*US%degC_to_C) ! [C ~> degC] + allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=T_shelf_bdry) ! [C ~> degC] allocate( CS%thickness_bdry_val(isd:ied,jsd:jed), source=0.0) allocate( CS%u_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) allocate( CS%v_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) @@ -1415,7 +1428,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, LB, time_step, hmask, h0, h_after do j=jsh,jeh ; do I=ish-1,ieh if (CS%u_face_mask(I,j) == 4.) then ! The flux itself is a specified boundary condition. uh_ice(I,j) = time_step * G%dyCu(I,j) * CS%u_flux_bdry_val(I,j) - elseif ((hmask(i,j)==1) .or. (hmask(i+1,j) == 1)) then + elseif ((hmask(i,j) == 1) .or. (hmask(i+1,j) == 1)) then u_face = 0.5 * (CS%u_shelf(I,J-1) + CS%u_shelf(I,J)) h_face = 0.0 ! This will apply when the source cell is iceless or not fully ice covered. @@ -1494,7 +1507,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, LB, time_step, hmask, h0, h_after do J=jsh-1,jeh ; do i=ish,ieh if (CS%v_face_mask(i,J) == 4.) then ! The flux itself is a specified boundary condition. vh_ice(i,J) = time_step * G%dxCv(i,J) * CS%v_flux_bdry_val(i,J) - elseif ((hmask(i,j)==1) .or. (hmask(i,j+1) == 1)) then + elseif ((hmask(i,j) == 1) .or. (hmask(i,j+1) == 1)) then v_face = 0.5 * (CS%v_shelf(I-1,J) + CS%v_shelf(I,J)) h_face = 0.0 ! This will apply when the source cell is iceless or not fully ice covered. @@ -1854,7 +1867,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) else - S(i,j)=ISS%h_shelf(i,j)-CS%bed_elev(i,j) + S(i,j) = ISS%h_shelf(i,j)-CS%bed_elev(i,j) endif enddo enddo @@ -2219,12 +2232,12 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, bathyT(i,j), dens_ratio, Usub, Vsub) - if (umask(I-1,J-1)==1) uret(I-1,J-1) = uret(I-1,J-1) + Usub(1,1) * basal_trac(i,j) + if (umask(I-1,J-1) == 1) uret(I-1,J-1) = uret(I-1,J-1) + Usub(1,1) * basal_trac(i,j) if (umask(I-1,J) == 1) uret(I-1,J) = uret(I-1,J) + Usub(1,2) * basal_trac(i,j) if (umask(I,J-1) == 1) uret(I,J-1) = uret(I,J-1) + Usub(2,1) * basal_trac(i,j) if (umask(I,J) == 1) uret(I,J) = uret(I,J) + Usub(2,2) * basal_trac(i,j) - if (vmask(I-1,J-1)==1) vret(I-1,J-1) = vret(I-1,J-1) + Vsub(1,1) * basal_trac(i,j) + if (vmask(I-1,J-1) == 1) vret(I-1,J-1) = vret(I-1,J-1) + Vsub(1,1) * basal_trac(i,j) if (vmask(I-1,J) == 1) vret(I-1,J) = vret(I-1,J) + Vsub(1,2) * basal_trac(i,j) if (vmask(I,J-1) == 1) vret(I,J-1) = vret(I,J-1) + Vsub(2,1) * basal_trac(i,j) if (vmask(I,J) == 1) vret(I,J) = vret(I,J) + Vsub(2,2) * basal_trac(i,j) @@ -2550,12 +2563,12 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, CS%bed_elev(i,j), & dens_ratio, Usubcontr, Vsubcontr) - if (CS%umask(I-1,J-1)==1) u_bdry_contr(I-1,J-1) = u_bdry_contr(I-1,J-1) + Usubcontr(1,1) * basal_trac(i,j) + if (CS%umask(I-1,J-1) == 1) u_bdry_contr(I-1,J-1) = u_bdry_contr(I-1,J-1) + Usubcontr(1,1) * basal_trac(i,j) if (CS%umask(I-1,J) == 1) u_bdry_contr(I-1,J) = u_bdry_contr(I-1,J) + Usubcontr(1,2) * basal_trac(i,j) if (CS%umask(I,J-1) == 1) u_bdry_contr(I,J-1) = u_bdry_contr(I,J-1) + Usubcontr(2,1) * basal_trac(i,j) if (CS%umask(I,J) == 1) u_bdry_contr(I,J) = u_bdry_contr(I,J) + Usubcontr(2,2) * basal_trac(i,j) - if (CS%vmask(I-1,J-1)==1) v_bdry_contr(I-1,J-1) = v_bdry_contr(I-1,J-1) + Vsubcontr(1,1) * basal_trac(i,j) + if (CS%vmask(I-1,J-1) == 1) v_bdry_contr(I-1,J-1) = v_bdry_contr(I-1,J-1) + Vsubcontr(1,1) * basal_trac(i,j) if (CS%vmask(I-1,J) == 1) v_bdry_contr(I-1,J) = v_bdry_contr(I-1,J) + Vsubcontr(1,2) * basal_trac(i,j) if (CS%vmask(I,J-1) == 1) v_bdry_contr(I,J-1) = v_bdry_contr(I,J-1) + Vsubcontr(2,1) * basal_trac(i,j) if (CS%vmask(I,J) == 1) v_bdry_contr(I,J) = v_bdry_contr(I,J) + Vsubcontr(2,2) * basal_trac(i,j) @@ -2610,7 +2623,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) enddo ; enddo n_g = CS%n_glen; eps_min = CS%eps_glen_min - CS%ice_visc(:,:)=1e22 + CS%ice_visc(:,:) = 1.0e22 ! Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) do j=jsc,jec ; do i=isc,iec @@ -2639,13 +2652,13 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) enddo ; enddo - if (trim(CS%ice_viscosity_compute)=="CONSTANT") then + if (trim(CS%ice_viscosity_compute) == "CONSTANT") then CS%ice_visc(i,j) = 1e15 * US%kg_m3_to_R*US%m_to_L*US%m_s_to_L_T * (G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging - elseif (trim(CS%ice_viscosity_compute)=="MODEL") then + elseif (trim(CS%ice_viscosity_compute) == "MODEL") then CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - elseif (trim(CS%ice_viscosity_compute)=="OBS") then + elseif (trim(CS%ice_viscosity_compute) == "OBS") then if (CS%AGlen_visc(i,j) >0) CS%ice_visc(i,j) = CS%AGlen_visc(i,j)*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! Here CS%Aglen_visc(i,j) is the ice viscocity [Pa s-1] computed from obs and read from a file endif @@ -3008,23 +3021,23 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%u_face_mask_bdry(I-1+k,j))) case (3) - vmask(I-1+k,J-1)=3. - u_face_mask(I-1+k,j)=3. - umask(I-1+k,J)=3. - vmask(I-1+k,J)=3. - vmask(I-1+k,J)=3. + vmask(I-1+k,J-1) = 3. + u_face_mask(I-1+k,j) = 3. + umask(I-1+k,J) = 3. + vmask(I-1+k,J) = 3. + vmask(I-1+k,J) = 3. case (2) - u_face_mask(I-1+k,j)=2. + u_face_mask(I-1+k,j) = 2. case (4) - umask(I-1+k,J-1:J)=0. - vmask(I-1+k,J-1:J)=0. - u_face_mask(I-1+k,j)=4. + umask(I-1+k,J-1:J) = 0. + vmask(I-1+k,J-1:J) = 0. + u_face_mask(I-1+k,j) = 4. case (0) - umask(I-1+k,J-1:J)=0. - vmask(I-1+k,J-1:J)=0. - u_face_mask(I-1+k,j)=0. + umask(I-1+k,J-1:J) = 0. + vmask(I-1+k,J-1:J) = 0. + u_face_mask(I-1+k,j) = 0. case (1) ! stress free x-boundary - umask(I-1+k,J-1:J)=0. + umask(I-1+k,J-1:J) = 0. case default end select enddo @@ -3033,23 +3046,23 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) - vmask(I-1,J-1+k)=3. - umask(I-1,J-1+k)=3. - vmask(I,J-1+k)=3. - umask(I,J-1+k)=3. - v_face_mask(i,J-1+k)=3. + vmask(I-1,J-1+k) = 3. + umask(I-1,J-1+k) = 3. + vmask(I,J-1+k) = 3. + umask(I,J-1+k) = 3. + v_face_mask(i,J-1+k) = 3. case (2) - v_face_mask(i,J-1+k)=2. + v_face_mask(i,J-1+k) = 2. case (4) - umask(I-1:I,J-1+k)=0. - vmask(I-1:I,J-1+k)=0. - v_face_mask(i,J-1+k)=4. + umask(I-1:I,J-1+k) = 0. + vmask(I-1:I,J-1+k) = 0. + v_face_mask(i,J-1+k) = 4. case (0) - umask(I-1:I,J-1+k)=0. - vmask(I-1:I,J-1+k)=0. - v_face_mask(i,J-1+k)=0. + umask(I-1:I,J-1+k) = 0. + vmask(I-1:I,J-1+k) = 0. + v_face_mask(i,J-1+k) = 0. case (1) ! stress free y-boundary - vmask(I-1:I,J-1+k)=0. + vmask(I-1:I,J-1+k) = 0. case default end select enddo @@ -3223,7 +3236,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) if (ISS%h_shelf(i,j) > 0.0) then CS%t_shelf(i,j) = th_after_vflux(i,j) / ISS%h_shelf(i,j) else - CS%t_shelf(i,j) = -10.0*US%degC_to_C + CS%t_shelf(i,j) = CS%T_shelf_missing endif ! endif @@ -3234,11 +3247,11 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) else ! the ice is about to melt away in this case set thickness, area, and mask to zero ! NOTE: not mass conservative, should maybe scale salt & heat flux for this cell - CS%t_shelf(i,j) = -10.0*US%degC_to_C + CS%t_shelf(i,j) = CS%T_shelf_missing CS%tmask(i,j) = 0.0 endif elseif (ISS%hmask(i,j) == 0) then - CS%t_shelf(i,j) = -10.0*US%degC_to_C + CS%t_shelf(i,j) = CS%T_shelf_missing elseif ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = CS%t_bdry_val(i,j) endif From f86d762bbb500a9af83e6cb565b4b127b5073bf3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Dec 2022 13:12:59 -0500 Subject: [PATCH 100/213] +Pass ocean_grid_type to call_tracer_register Pass ocean_grid_type arguments to call_tracer_register and call_OBC_register in place of the hor_index_type arguments that had been used previously. Also use these ocean_grid_type arguments in calls to register_shelfwave_OBC, register_RGC_tracer and register_advection_test_tracer. Within these three routines, the contents of the ocean_grid_type are used to specify axis units. The new runtime parameter SHELFWAVE_AMPLITUDE was added to allow for run-time control of the amplitude of the shelfwave test case. By default all answers are bitwise identical, but there are some changes in the units of parameters as documented in the MOM_parameter_doc files and a new entry in these files for the shelfwave test case. --- src/core/MOM.F90 | 6 +- src/core/MOM_boundary_update.F90 | 16 +++-- src/tracer/MOM_tracer_flow_control.F90 | 36 +++++------ src/tracer/RGC_tracer.F90 | 15 ++--- src/tracer/advection_test_tracer.F90 | 89 +++++++++++++------------- src/user/shelfwave_initialization.F90 | 79 ++++++++++------------- 6 files changed, 114 insertions(+), 127 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3cac9583cb..c0ff15e858 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2177,7 +2177,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "at the end of the step.", default=.false.) if (CS%split) then - call get_param(param_file, "MOM", "DTBT", dtbt, default=-0.98) + call get_param(param_file, "MOM", "DTBT", dtbt, units="s or nondim", default=-0.98) default_val = US%T_to_s*CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 CS%dtbt_reset_period = -1.0 call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, & @@ -2637,7 +2637,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(HI, GV, US, param_file, CS%tracer_flow_CSp, & + call call_tracer_register(G, GV, US, param_file, CS%tracer_flow_CSp, & CS%tracer_Reg, restart_CSp) call MEKE_alloc_register_restart(HI, US, param_file, CS%MEKE, restart_CSp) @@ -2661,7 +2661,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(CS%OBC)) then ! Set up remaining information about open boundary conditions that is needed for OBCs. - call call_OBC_register(param_file, CS%update_OBC_CSp, US, CS%OBC, CS%tracer_Reg) + call call_OBC_register(G, GV, US, param_file, CS%update_OBC_CSp, CS%OBC, CS%tracer_Reg) !### Package specific changes to OBCs need to go here? ! This is the equivalent to 2 calls to register_segment_tracer (per segment), which diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 11973f8c02..5a098cdf84 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -59,12 +59,14 @@ module MOM_boundary_update !> The following subroutines and associated definitions provide the !! machinery to register and call the subroutines that initialize !! open boundary conditions. -subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) - type(param_file_type), intent(in) :: param_file !< Parameter file to parse - type(update_OBC_CS), pointer :: CS !< Control structure for OBCs - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. +subroutine call_OBC_register(G, GV, US, param_file, CS, OBC, tr_Reg) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file to parse + type(update_OBC_CS), pointer :: CS !< Control structure for OBCs + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. ! Local variables character(len=200) :: config @@ -124,7 +126,7 @@ subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) register_Kelvin_OBC(param_file, CS%Kelvin_OBC_CSp, US, & OBC%OBC_Reg) if (CS%use_shelfwave) CS%use_shelfwave = & - register_shelfwave_OBC(param_file, CS%shelfwave_OBC_CSp, US, & + register_shelfwave_OBC(param_file, CS%shelfwave_OBC_CSp, G, US, & OBC%OBC_Reg) if (CS%use_dyed_channel) CS%use_dyed_channel = & register_dyed_channel_OBC(param_file, CS%dyed_channel_OBC_CSp, US, & diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 46001a2dc3..bf7076d4bb 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -152,8 +152,8 @@ end subroutine call_tracer_flux_init !> This subroutine determines which tracer packages are to be used and does the calls to !! register their tracers to be advected, diffused, and read from restarts. -subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. +subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -163,7 +163,7 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the !! control structure for the tracer !! advection and diffusion module. - type(MOM_restart_CS), intent(inout) :: restart_CS !< A pointer to the restart control + type(MOM_restart_CS), intent(inout) :: restart_CS !< A pointer to the restart control !! structure. ! This include declares and sets the variable "version". @@ -230,49 +230,49 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! tracer package registration call returns a logical false if it cannot be run ! for some reason. This then overrides the run-time selection from above. if (CS%use_USER_tracer_example) CS%use_USER_tracer_example = & - USER_register_tracer_example(HI, GV, param_file, CS%USER_tracer_example_CSp, & + USER_register_tracer_example(G%HI, GV, param_file, CS%USER_tracer_example_CSp, & tr_Reg, restart_CS) if (CS%use_DOME_tracer) CS%use_DOME_tracer = & - register_DOME_tracer(HI, GV, param_file, CS%DOME_tracer_CSp, & + register_DOME_tracer(G%HI, GV, param_file, CS%DOME_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ISOMIP_tracer) CS%use_ISOMIP_tracer = & - register_ISOMIP_tracer(HI, GV, param_file, CS%ISOMIP_tracer_CSp, & + register_ISOMIP_tracer(G%HI, GV, param_file, CS%ISOMIP_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_RGC_tracer) CS%use_RGC_tracer = & - register_RGC_tracer(HI, GV, param_file, CS%RGC_tracer_CSp, & + register_RGC_tracer(G, GV, param_file, CS%RGC_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ideal_age) CS%use_ideal_age = & - register_ideal_age_tracer(HI, GV, param_file, CS%ideal_age_tracer_CSp, & + register_ideal_age_tracer(G%HI, GV, param_file, CS%ideal_age_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_regional_dyes) CS%use_regional_dyes = & - register_dye_tracer(HI, GV, US, param_file, CS%dye_tracer_CSp, & + register_dye_tracer(G%HI, GV, US, param_file, CS%dye_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_oil) CS%use_oil = & - register_oil_tracer(HI, GV, US, param_file, CS%oil_tracer_CSp, & + register_oil_tracer(G%HI, GV, US, param_file, CS%oil_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_advection_test_tracer) CS%use_advection_test_tracer = & - register_advection_test_tracer(HI, GV, param_file, CS%advection_test_tracer_CSp, & + register_advection_test_tracer(G, GV, param_file, CS%advection_test_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_OCMIP2_CFC) CS%use_OCMIP2_CFC = & - register_OCMIP2_CFC(HI, GV, param_file, CS%OCMIP2_CFC_CSp, & + register_OCMIP2_CFC(G%HI, GV, param_file, CS%OCMIP2_CFC_CSp, & tr_Reg, restart_CS) if (CS%use_CFC_cap) CS%use_CFC_cap = & - register_CFC_cap(HI, GV, param_file, CS%CFC_cap_CSp, & + register_CFC_cap(G%HI, GV, param_file, CS%CFC_cap_CSp, & tr_Reg, restart_CS) if (CS%use_MOM_generic_tracer) CS%use_MOM_generic_tracer = & - register_MOM_generic_tracer(HI, GV, param_file, CS%MOM_generic_tracer_CSp, & + register_MOM_generic_tracer(G%HI, GV, param_file, CS%MOM_generic_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_pseudo_salt_tracer) CS%use_pseudo_salt_tracer = & - register_pseudo_salt_tracer(HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & + register_pseudo_salt_tracer(G%HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_boundary_impulse_tracer) CS%use_boundary_impulse_tracer = & - register_boundary_impulse_tracer(HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & + register_boundary_impulse_tracer(G%HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = & - register_dyed_obc_tracer(HI, GV, param_file, CS%dyed_obc_tracer_CSp, & + register_dyed_obc_tracer(G%HI, GV, param_file, CS%dyed_obc_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_nw2_tracers) CS%use_nw2_tracers = & - register_nw2_tracers(HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) + register_nw2_tracers(G%HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 7c9b52b66e..474fcb0c23 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -60,10 +60,9 @@ module RGC_tracer contains - !> This subroutine is used to register tracer fields -function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. +function register_RGC_tracer(G, GV, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file ! NULL() ! A pointer to one of the tracers in this module [kg kg-1] logical :: register_RGC_tracer integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "RGC_register_tracer called with an "// & @@ -108,13 +107,11 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "CONT_SHELF_LENGTH", CS%CSL, & "The length of the continental shelf (x dir, km).", & - units="km", default=15.0) - ! units=G%x_ax_unit_short, default=15.0) + units=G%x_ax_unit_short, default=15.0) call get_param(param_file, mdl, "LENSPONGE", CS%lensponge, & "The length of the sponge layer (km).", & - units="km", default=10.0) - ! units=G%x_ax_unit_short, default=10.0) + units=G%x_ax_unit_short, default=10.0) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) if (CS%mask_tracers) then @@ -130,7 +127,7 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This is needed to force the compiler not to do a copy in the registration calls. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for horizontal advection & diffusion. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., flux_units="kg/s", & restart_CS=restart_CS) diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 5e43ce5757..d8eb4d57fb 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -3,25 +3,25 @@ module advection_test_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coms, only : EFP_type -use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS -use MOM_spatial_means, only : global_mass_int_EFP -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_coms, only : EFP_type +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -40,16 +40,16 @@ module advection_test_tracer character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? - real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine [conc] + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out [conc] logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. logical :: tracers_may_reinit !< If true, the tracers may be set up via the initialization code if !! they are not found in the restart files. Otherwise it is a fatal error !! if the tracers are not found in the restart files of a restarted run. - real :: x_origin !< Parameters describing the test functions - real :: x_width !< Parameters describing the test functions - real :: y_origin !< Parameters describing the test functions - real :: y_width !< Parameters describing the test functions + real :: x_origin !< Starting x-position of the tracer [m] or [km] or [degrees_E] + real :: x_width !< Initial size in the x-direction of the tracer patch [m] or [km] or [degrees_E] + real :: y_origin !< Starting y-position of the tracer [m] or [km] or [degrees_N] + real :: y_width !< Initial size in the y-direction of the tracer patch [m] or [km] or [degrees_N] integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and !! the surface tracer concentrations are to be provided to the coupler. @@ -64,8 +64,8 @@ module advection_test_tracer contains !> Register tracer fields and subroutines to be used with MOM. -function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure +function register_advection_test_tracer(G, GV, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -80,13 +80,13 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "advection_test_tracer" ! This module's name. - character(len=200) :: inputdir + character(len=200) :: inputdir ! The directory where the input file can be found character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to a tracer array [conc] logical :: register_advection_test_tracer integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "register_advection_test_tracer called with an "// & @@ -98,13 +98,13 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ADVECTION_TEST_X_ORIGIN", CS%x_origin, & - "The x-coordinate of the center of the test-functions.", units="same as geoLon", default=0.) + "The x-coordinate of the center of the test-functions.", units=G%x_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_Y_ORIGIN", CS%y_origin, & - "The y-coordinate of the center of the test-functions.", units="same as geoLat", default=0.) + "The y-coordinate of the center of the test-functions.", units=G%y_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_X_WIDTH", CS%x_width, & - "The x-width of the test-functions.", units="same as geoLon", default=0.) + "The x-width of the test-functions.", units=G%x_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_Y_WIDTH", CS%y_width, & - "The y-width of the test-functions.", units="same as geoLat", default=0.) + "The y-width of the test-functions.", units=G%y_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial "//& "conditions for the tracers, or blank to initialize "//& @@ -143,7 +143,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for horizontal advection, diffusion, and restarts. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., flux_units=flux_units, & restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit) @@ -181,12 +181,13 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. ! Local variables - character(len=16) :: name ! A variable's name in a NetCDF file. + character(len=16) :: name ! A variable's name in a NetCDF file. + real :: locx, locy ! x- and y- positions relative to the center of the tracer patch + ! normalized by its size [nondim] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB - real :: locx, locy if (.not.associated(CS)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -211,28 +212,28 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS enddo ; enddo k=2 ! Triangle wave do j=js,je ; do i=is,ie - locx=abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width - locy=abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width + locx = abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width + locy = abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width CS%tr(i,j,k,m) = max(0.0, 1.0-locx)*max(0.0, 1.0-locy) enddo ; enddo k=3 ! Cosine bell do j=js,je ; do i=is,ie - locx=min(1.0, abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width)*(acos(0.0)*2.) - locy=min(1.0, abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width)*(acos(0.0)*2.) + locx = min(1.0, abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width) * (acos(0.0)*2.) + locy = min(1.0, abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width) * (acos(0.0)*2.) CS%tr(i,j,k,m) = (1.0+cos(locx))*(1.0+cos(locy))*0.25 enddo ; enddo k=4 ! Cylinder do j=js,je ; do i=is,ie - locx=abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width - locy=abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width + locx = abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width + locy = abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0 enddo ; enddo k=5 ! Cut cylinder do j=js,je ; do i=is,ie - locx=(G%geoLonT(i,j)-CS%x_origin)/CS%x_width - locy=(G%geoLatT(i,j)-CS%y_origin)/CS%y_width + locx = (G%geoLonT(i,j)-CS%x_origin)/CS%x_width + locy = (G%geoLatT(i,j)-CS%y_origin)/CS%y_width if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0 - if (locx>0.0.and.abs(locy)<0.2) CS%tr(i,j,k,m) = 0.0 + if (locx>0.0 .and. abs(locy)<0.2) CS%tr(i,j,k,m) = 0.0 enddo ; enddo call set_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp) diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 7d588c49a0..5d7f1b7e97 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -28,29 +28,30 @@ module shelfwave_initialization !> Control structure for shelfwave open boundaries. type, public :: shelfwave_OBC_CS ; private - real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] - real :: Ly = 50.0 !< Cross-shore length scale [km] - real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] - real :: jj = 1.0 !< Cross-shore wave mode [nondim] - real :: kk !< Cross-shore wavenumber [km-1] - real :: ll !< Longshore wavenumber [km-1] - real :: alpha !< Exponential decay rate in the y-direction [km-1] - real :: omega !< Frequency of the shelf wave [T-1 ~> s-1] + real :: my_amp !< Amplitude of the open boundary current inflows [L T-1 ~> m s-1] + real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] or [m] + real :: Ly = 50.0 !< Cross-shore length scale [km] or [m] + real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] + real :: jj = 1.0 !< Cross-shore wave mode [nondim] + real :: kk !< Cross-shore wavenumber [km-1] or [m-1] + real :: ll !< Longshore wavenumber [km-1] or [m-1] + real :: alpha !< Exponential decay rate in the y-direction [km-1] or [m-1] + real :: omega !< Frequency of the shelf wave [T-1 ~> s-1] end type shelfwave_OBC_CS contains !> Add shelfwave to OBC registry. -function register_shelfwave_OBC(param_file, CS, US, OBC_Reg) +function register_shelfwave_OBC(param_file, CS, G, US, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(shelfwave_OBC_CS), pointer :: CS !< shelfwave control structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OBC_registry_type), pointer :: OBC_Reg !< Open boundary condition registry. logical :: register_shelfwave_OBC + ! Local variables real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] - real :: len_lat ! Y-direction size of the domain [km] - character(len=32) :: casename = "shelfwave" !< This case's name. PI = 4.0*atan(1.0) @@ -62,30 +63,26 @@ function register_shelfwave_OBC(param_file, CS, US, OBC_Reg) endif allocate(CS) - !### Revise these parameters once the ocean_grid_type is available. - ! Register the tracer for horizontal advection & diffusion. call register_OBC(casename, param_file, OBC_Reg) call get_param(param_file, mdl, "F_0", CS%f0, & default=0.0, units="s-1", scale=US%T_to_s, do_not_log=.true.) - call get_param(param_file, mdl, "LENLAT", len_lat, & - units="km", do_not_log=.true., fail_if_missing=.true.) call get_param(param_file, mdl,"SHELFWAVE_X_WAVELENGTH", CS%Lx, & "Length scale of shelfwave in x-direction.",& - units="km", default=100.) -! units="km", default=100.0, scale=1.0e3*US%m_to_L) - ! units=G%x_ax_unit_short, default=100.) + units=G%x_ax_unit_short, default=100.) call get_param(param_file, mdl, "SHELFWAVE_Y_LENGTH_SCALE", CS%Ly, & "Length scale of exponential dropoff of topography in the y-direction.", & - units="km", default=50.) -! units="km", default=50.0, scale=1.0e3*US%m_to_L) - ! units=G%y_ax_unit_short, default=50.) + units=G%y_ax_unit_short, default=50.) call get_param(param_file, mdl, "SHELFWAVE_Y_MODE", CS%jj, & "Cross-shore wave mode.", & units="nondim", default=1.) + call get_param(param_file, mdl, "SHELFWAVE_AMPLITUDE", CS%my_amp, & + "Amplitude of the open boundary current inflows in the shelfwave configuration.", & + units="m s-1", default=1.0, scale=US%m_s_to_L_T) + CS%alpha = 1. / CS%Ly CS%ll = 2. * PI / CS%Lx - CS%kk = CS%jj * PI / len_lat + CS%kk = CS%jj * PI / G%len_lat CS%omega = 2 * CS%alpha * CS%f0 * CS%ll / & (CS%kk*CS%kk + CS%alpha*CS%alpha + CS%ll*CS%ll) register_shelfwave_OBC = .true. @@ -111,16 +108,16 @@ subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: y ! Position relative to the southern boundary [km] or [degrees_N] - real :: rLy ! Exponential decay rate of the topography [km-1] or [degrees_N-1] - real :: Ly ! Exponential decay lengthscale of the topography [km] or [degrees_N] + real :: y ! Position relative to the southern boundary [km] or [m] or [degrees_N] + real :: rLy ! Exponential decay rate of the topography [km-1] or [m-1] or [degrees_N-1] + real :: Ly ! Exponential decay lengthscale of the topography [km] or [m] or [degrees_N] real :: H0 ! The minimum depth of the ocean [Z ~> m] integer :: i, j call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE", Ly, & units=G%y_ax_unit_short, default=50., do_not_log=.true.) call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & - default=10., units="m", scale=US%m_to_Z, do_not_log=.true.) + units="m", default=10., scale=US%m_to_Z, do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly @@ -145,15 +142,10 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the shelfwave example. - real :: my_amp ! Amplitude of the open boundary current inflows [L T-1 ~> m s-1] real :: time_sec ! The time in the run [T ~> s] real :: cos_wt, sin_wt ! Cosine and sine associated with the propagating x-direction structure [nondim] real :: cos_ky, sin_ky ! Cosine and sine associated with the y-direction structure [nondim] - real :: omega ! Frequency of the shelf wave [T-1 ~> s-1] - real :: alpha ! Exponential decay rate in the y-direction [km-1] - real :: x, y ! Positions relative to the western and southern boundaries [km] - real :: kk ! y-direction wavenumber of the wave [km-1] - real :: ll ! x-direction wavenumber of the wave [km-1] + real :: x, y ! Positions relative to the western and southern boundaries [km] or [m] or [degrees] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, n integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() @@ -165,11 +157,6 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) if (.not.associated(OBC)) return time_sec = US%s_to_T*time_type_to_real(Time) - omega = CS%omega - alpha = CS%alpha - my_amp = 1.0*US%m_s_to_L_T - kk = CS%kk - ll = CS%ll do n = 1, OBC%number_of_segments segment => OBC%segment(n) if (.not. segment%on_pe) cycle @@ -180,15 +167,15 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) do j=jsd,jed ; do I=IsdB,IedB x = G%geoLonCu(I,j) - G%west_lon y = G%geoLatCu(I,j) - G%south_lat - sin_wt = sin(ll*x - omega*time_sec) - cos_wt = cos(ll*x - omega*time_sec) - sin_ky = sin(kk * y) - cos_ky = cos(kk * y) - segment%normal_vel_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * & - (alpha * sin_ky + kk * cos_ky) -! segment%tangential_vel_bt(I,j) = my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky -! segment%vorticity_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * sin_ky& -! (ll*ll + kk*kk + alpha*alpha) + sin_wt = sin(CS%ll*x - CS%omega*time_sec) + cos_wt = cos(CS%ll*x - CS%omega*time_sec) + sin_ky = sin(CS%kk * y) + cos_ky = cos(CS%kk * y) + segment%normal_vel_bt(I,j) = CS%my_amp * exp(- CS%alpha * y) * cos_wt * & + (CS%alpha * sin_ky + CS%kk * cos_ky) +! segment%tangential_vel_bt(I,j) = CS%my_amp * CS%ll * exp(- CS%alpha * y) * sin_wt * sin_ky +! segment%vorticity_bt(I,j) = CS%my_amp * exp(- CS%alpha * y) * cos_wt * sin_ky& +! (CS%ll**2 + CS%kk**2 + CS%alpha**2) enddo ; enddo enddo From 78da7780e81525a9e36a1467f9b0d3c6bad3441e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 23 Dec 2022 06:37:10 -0500 Subject: [PATCH 101/213] +Add runtime parameters for benchmark_initialization Added the new runtime parameter BENCHMARK_T_LIGHT and reuse the existing parameter S_REF to specify the previously hard-coded dimensional parameters in the benchmark_initialization module. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for the benchmark test case. --- src/user/benchmark_initialization.F90 | 30 ++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 7d1656e191..a9344a6a30 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -101,9 +101,11 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! in depth units [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: SST ! The initial sea surface temperature [C ~> degC]. - real :: T_int ! The initial temperature of an interface [C ~> degC]. - real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. + real :: SST ! The initial sea surface temperature [C ~> degC]. + real :: S_ref ! A default value for salinities [S ~> ppt] + real :: T_light ! A first guess at the temperature of the lightest layer [C ~> degC] + real :: T_int ! The initial temperature of an interface [C ~> degC]. + real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units [Z ~> m]. real, dimension(SZK_(GV)) :: & T0, S0, & ! Profiles of temperature [C ~> degC] and salinity [S ~> ppt] @@ -135,6 +137,12 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e call get_param(param_file, mdl, "BENCHMARK_THERMOCLINE_SCALE", thermocline_scale, & "Initial thermocline depth scale in the benchmark test case.", & default=500.0, units="m", scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "BENCHMARK_T_LIGHT", T_light, & + "A first guess at the temperature of the lightest layer in the benchmark test case.", & + units="degC", default=29.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_ref, & + "The uniform salinities used to initialize the benchmark test case.", & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! This subroutine has no run-time parameters. @@ -147,9 +155,9 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! This block calculates T0(k) for the purpose of diagnosing where the ! interfaces will be found. do k=1,nz - pres(k) = P_Ref ; S0(k) = 35.0*US%ppt_to_S + pres(k) = P_Ref ; S0(k) = S_ref enddo - T0(k1) = 29.0*US%degC_to_C + T0(k1) = T_light call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) call calculate_density_derivs(T0(k1), S0(k1), pres(k1), drho_dT(k1), drho_dS(k1), eqn_of_state) @@ -232,25 +240,33 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & ! Local variables real :: T0(SZK_(GV)) ! A profile of temperatures [C ~> degC] real :: S0(SZK_(GV)) ! A profile of salinities [S ~> ppt] + real :: S_ref ! A default value for salinities [S ~> ppt] + real :: T_light ! A first guess at the temperature of the lightest layer [C ~> degC] real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa] real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1] real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3] real :: PI ! 3.1415926... calculated as 4*atan(1) real :: SST ! The initial sea surface temperature [C ~> degC] + character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + call get_param(param_file, mdl, "S_REF", S_ref, & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "BENCHMARK_T_LIGHT", T_light, & + units="degC", default=29.0, scale=US%degC_to_C, do_not_log=.true.) + if (just_read) return ! All run-time parameters have been read, so return. k1 = GV%nk_rho_varies + 1 do k=1,nz - pres(k) = P_Ref ; S0(k) = 35.0*US%ppt_to_S + pres(k) = P_Ref ; S0(k) = S_ref enddo - T0(k1) = 29.0*US%degC_to_C + T0(k1) = T_light call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, (/k1,k1/) ) From 9fd2bd03927befe1a03b9ac1fc7ca16e443143c6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 23 Dec 2022 06:37:28 -0500 Subject: [PATCH 102/213] +Add runtime parameters for DOME2d_initialization Added the new runtime parameters INITIAL_SSS, DOME2D_T_BAY and DOME2D_EAST_SPONGE_S_RANGE to specify the previously hard-coded dimensional parameters in the DOME2d_initialization module. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for the flow_downslope and similar test cases. --- src/user/DOME2d_initialization.F90 | 43 ++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 1c2b71334f..1382fe8e34 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -40,9 +40,9 @@ module DOME2d_initialization subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables real :: bay_depth ! Depth of shelf, as fraction of basin depth [nondim] @@ -239,6 +239,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi real :: delta_S ! Change in salinity between layers [S ~> ppt] real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical + real :: S_surf ! Initial surface salinity [S ~> ppt] + real :: T_bay ! Temperature in the inflow embayment [C ~> degC] real :: xi0, xi1 ! Fractional vertical positions [nondim] real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] @@ -262,9 +264,14 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_RANGE", S_range,' Initial salinity range', & - units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) + units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, "Initial surface salinity", & + units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "DOME2D_T_BAY", T_bay, & + "Temperature in the inflow embayment in the DOME2d test case", & + units="degC", default=1.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -281,7 +288,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi xi0 = 0.0 do k = 1,nz xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth - S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo enddo ; enddo @@ -292,12 +299,12 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi xi0 = 0.0 do k = 1,nz xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth - S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,nz) = 34.0*US%ppt_to_S + S_range + S(i,j,nz) = S_surf + S_range endif enddo ; enddo @@ -322,7 +329,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then S(i,j,1:index_bay_z) = S_ref + S_range ! Use for z coordinates - T(i,j,1:index_bay_z) = 1.0*US%degC_to_C ! Use for z coordinates + T(i,j,1:index_bay_z) = T_bay ! Use for z coordinates endif enddo ; enddo ! i and j loops endif ! Z initial conditions @@ -332,8 +339,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,1:GV%ke) = S_ref + S_range ! Use for sigma coordinates - T(i,j,1:GV%ke) = 1.0*US%degC_to_C ! Use for sigma coordinates + S(i,j,1:GV%ke) = S_ref + S_range ! Use for sigma coordinates + T(i,j,1:GV%ke) = T_bay ! Use for sigma coordinates endif enddo ; enddo endif @@ -344,7 +351,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - T(i,j,GV%ke) = 1.0*US%degC_to_C + T(i,j,GV%ke) = T_bay endif enddo ; enddo endif @@ -373,6 +380,8 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A real :: T_ref ! Reference temperature within the surface layer [C ~> degC] real :: S_range ! Range of salinities in the vertical [S ~> ppt] real :: T_range ! Range of temperatures in the vertical [C ~> degC] + real :: S_range_sponge ! Range of salinities in the vertical in the east sponge [S ~> ppt] + real :: S_surf ! Initial surface salinity [S ~> ppt] real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface @@ -428,7 +437,11 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A call get_param(param_file, mdl, "T_REF", T_ref, units="degC", scale=US%degC_to_C, fail_if_missing=.false.) call get_param(param_file, mdl, "S_RANGE", S_range, units="ppt", default=2.0, scale=US%ppt_to_S) call get_param(param_file, mdl, "T_RANGE", T_range, units="degC", default=0.0, scale=US%degC_to_C) - + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, "Initial surface salinity", & + units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "DOME2D_EAST_SPONGE_S_RANGE", S_range_sponge, & + "Range of salinities in the eastern sponge region in the DOME2D configuration", & + units="1e-3", default=1.0, scale=US%ppt_to_S) ! Set the sponge damping rate as a function of position Idamp(:,:) = 0.0 @@ -454,7 +467,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A if (use_ALE) then - ! Construct a grid (somewhat arbitrarily) to describe the sponge T/S on + ! Construct a grid (somewhat arbitrarily) to describe the sponge T/S on do k=1,nz e0(k) = -G%max_depth * ( real(k-1) / real(nz) ) enddo @@ -480,7 +493,9 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A z = -depth_tot(i,j) do k = nz,1,-1 z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k - S(i,j,k) = 34.0*US%ppt_to_S - 1.0*US%ppt_to_S * (z / (G%max_depth)) + ! Use salinity stratification in the eastern sponge. + S(i,j,k) = S_surf - S_range_sponge * (z / G%max_depth) + ! Use a constant salinity in the western sponge. if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k From f1aed7784cbacc21eb203d21ec45c2268b638d34 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 23 Dec 2022 06:37:46 -0500 Subject: [PATCH 103/213] +Add runtime parameters for sloshing_initialization Added the new runtime parameters INITIAL_SSS and SLOSHING_T_PERT to specify the previously hard-coded dimensional parameters in the sloshing_initialization module. Also added comments documenting the purpose and units of the internal real variables in sloshing_initialization.F90. There is also a new comment questioning whether the temperature perturbations are being applied correctly, but for now the code reproduces the previous answers. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for the sloshing test cases. --- src/user/sloshing_initialization.F90 | 72 +++++++++++++++------------- 1 file changed, 38 insertions(+), 34 deletions(-) diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index de7869511b..357f247896 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -30,9 +30,9 @@ module sloshing_initialization subroutine sloshing_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables integer :: i, j @@ -60,23 +60,22 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. - logical, intent(in) :: just_read !< If true, this call will - !! only read parameters without changing h. + type(param_file_type), intent(in) :: param_file !< A structure to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. + ! Local variables real :: displ(SZK_(GV)+1) ! The interface displacement [Z ~> m]. real :: z_unif(SZK_(GV)+1) ! Fractional uniform interface heights [nondim]. real :: z_inter(SZK_(GV)+1) ! Interface heights [Z ~> m] real :: a0 ! The displacement amplitude [Z ~> m]. - real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. - real :: x1, y1, x2, y2 ! Dimensonless parameters. - real :: x, t ! Dimensionless depth coordinates? + real :: weight_z ! A depth-space weighting [nondim]. + real :: x1, y1, x2, y2 ! Dimensonless parameters specifying the depth profile [nondim] + real :: x, t ! Dimensionless depth coordinates scales [nondim] logical :: use_IC_bug ! If true, set the initial conditions retaining an old bug. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "sloshing_initialization" !< This module's name. - integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -133,7 +132,7 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, x = G%geoLonT(i,j) / G%len_lon if (use_IC_bug) then - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z ! There is a flag to fix this bug. else displ(k) = a0 * cos(acos(-1.0)*x) * weight_z endif @@ -176,29 +175,28 @@ end subroutine sloshing_initialize_thickness !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, just_read) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. - logical, intent(in) :: just_read !< If true, this call will - !! only read parameters without changing T & S. + type(param_file_type), intent(in) :: param_file !< A structure to parse + !! for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. + ! Local variables + real :: delta_T ! Temperature difference between layers [C ~> degC] + real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer + real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical + real :: S_surf ! Initial surface salinity [S ~> ppt] + real :: T_pert ! A perturbed temperature [C ~> degC] + integer :: kdelta ! Half the number of layers with the temperature perturbation + real :: deltah ! Thickness of each layer [Z ~> m] + real :: xi0, xi1 ! Fractional vertical positions [nondim] + character(len=40) :: mdl = "sloshing_initialization" ! This module's name. integer :: i, j, k, is, ie, js, je, nz - real :: delta_T - real :: S_ref, T_ref; ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within - ! surface layer - real :: S_range, T_range; ! Range of [S ~> ppt] and temperatures [C ~> degC] over the - ! vertical - integer :: kdelta - real :: deltah - real :: xi0, xi1 - character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's - ! name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -208,10 +206,15 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) ! The default is to assume an increase by 2 ppt for the salinity and a uniform temperature. - call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range.', & + call get_param(param_file, mdl, "S_RANGE", S_range, 'Initial salinity range.', & units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, "Initial surface salinity", & + units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "SLOSHING_T_PERT", T_pert, & + 'A mid-column temperature perturbation in the sloshing test case', & + units='degC', default=1.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -228,7 +231,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ xi0 = 0.0 do k = 1,nz xi1 = xi0 + deltah / G%max_depth ! = xi0 + 1.0 / real(nz) - S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo enddo ; enddo @@ -241,7 +244,8 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ T(:,:,k) = T(:,:,k-1) + delta_T enddo kdelta = 2 - T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = 1.0*US%degC_to_C + ! Perhaps the following lines should instead assign T() = T_pert + T_ref + T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = T_pert end subroutine sloshing_initialize_temperature_salinity From 8fa8f310495062050d1c6540021fcbbfa4a155ea Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 23 Dec 2022 06:38:04 -0500 Subject: [PATCH 104/213] +Add runtime parameters for DOME_initialization Added the new runtime parameters DOME_T_LIGHT and reuse the existing parameter S_REF to specify the previously hard-coded dimensional parameters in the DOME_initialization module. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for versions of the DOME test case with temperature and salinity as state variables. --- src/user/DOME_initialization.F90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e8a6ae713c..7f939ffef6 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -306,6 +306,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. + real :: S_ref ! A default value for salinities [S ~> ppt] + real :: T_light ! A first guess at the temperature of the lightest layer [C ~> degC] ! The following variables are used to set up the transport in the DOME example. real :: tr_0 ! The total integrated inflow transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: tr_k ! The integrated inflow transport of a layer [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -357,6 +359,13 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) "inflow properties.", units="s-1", default=f_0*US%s_to_T, scale=US%T_to_s) call get_param(PF, mdl, "DOME_INFLOW_LON", inflow_lon, & "The edge longitude of the DOME inflow.", units="km", default=1000.0) + if (associated(tv%S) .or. associated(tv%T)) then + call get_param(PF, mdl, "S_REF", S_ref, & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(PF, mdl, "DOME_T_LIGHT", T_light, & + "A first guess at the temperature of the lightest layer in the DOME test case.", & + units="degC", default=25.0, scale=US%degC_to_C) + endif if (.not.associated(OBC)) return @@ -413,16 +422,16 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) ! The inflow values of temperature and salinity also need to be set here if ! these variables are used. The following code is just a naive example. if (associated(tv%S)) then - ! In this example, all S inflows have values of 35 psu. + ! In this example, all S inflows have values given by S_ref. name = 'salt' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_scalar=35.0*US%ppt_to_S, scale=US%ppt_to_S) + call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_scalar=S_ref, scale=US%ppt_to_S) endif if (associated(tv%T)) then ! In this example, the T values are set to be consistent with the layer - ! target density and a salinity of 35 psu. This code is taken from + ! target density and a salinity of S_ref. This code is taken from ! USER_initialize_temp_sal. - pres(:) = tv%P_Ref ; S0(:) = 35.0*US%ppt_to_S ; T0(1) = 25.0*US%degC_to_C + pres(:) = tv%P_Ref ; S0(:) = S_ref ; T0(1) = T_light call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), tv%eqn_of_state) call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state, (/1,1/) ) From 9102dbe39e96a0e17e91e4f2d1df192ed4d79e30 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:12:33 -0500 Subject: [PATCH 105/213] +Add runtime parameter MIN_DZ_FOR_SLOPE_N2 Added the new runtime parameters MIN_DZ_FOR_SLOPE_N2 to specify a previously hard-coded dimensional parameter in the MOM_lateral_mixing_coeffs module. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for configurations using the some forms of the Eady growth rate slope calculation. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 29 ++++++++++--------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index f5dd0defdc..85049025b6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -67,6 +67,8 @@ module MOM_lateral_mixing_coeffs !! This parameter is set depending on other parameters. real :: cropping_distance !< Distance from surface or bottom to filter out outcropped or !! incropped interfaces for the Eady growth rate calc [Z ~> m] + real :: h_min_N2 !< The minimum vertical distance to use in the denominator of the + !! bouyancy frequency used in the slope calculation [Z ~> m] real, allocatable :: SN_u(:,:) !< S*N at u-points [T-1 ~> s-1] real, allocatable :: SN_v(:,:) !< S*N at v-points [T-1 ~> s-1] @@ -474,22 +476,19 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then + call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_simpler_Eady_growth_rate) then - call find_eta(h, tv, G, GV, US, e, halo_size=2) call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, dzu=dzu, dzv=dzv, & dzSxN=dzSxN, dzSyN=dzSyN, halo=1, OBC=OBC) call calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_u, CS%SN_v) + elseif (CS%use_stored_slopes) then + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & + CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) + call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) else - call find_eta(h, tv, G, GV, US, e, halo_size=2) - if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & - CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) - else - !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) - endif + !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) endif endif @@ -826,7 +825,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. real :: S2N2_u_local(SZIB_(G),SZJ_(G),SZK_(GV)) ! The depth integral of the slope times ! the buoyancy frequency squared at u-points [Z T-2 ~> m s-2] real :: S2N2_v_local(SZI_(G),SZJB_(G),SZK_(GV)) ! The depth integral of the slope times @@ -846,7 +844,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) @@ -887,7 +884,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 S2N2_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -898,7 +895,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 S2N2_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -1284,6 +1281,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & units="nondim", default=2) + call get_param(param_file, mdl, "MIN_DZ_FOR_SLOPE_N2", CS%h_min_N2, & + "The minimum vertical distance to use in the denominator of the "//& + "bouyancy frequency used in the slope calculation.", & + units="m", default=1.0, scale=GV%m_to_H, do_not_log=CS%use_stored_slopes) endif endif From 90457125caa55a26049a5f618693f3c249ff55be Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:13:11 -0500 Subject: [PATCH 106/213] +Add runtime parameter EN_CHECK_TOLERANCE Added the new runtime parameters EN_CHECK_TOLERANCE to specify a previously hard-coded dimensional tolerance in the MOM_internal_tides module. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for configurations using the MOM_internal_tides module. --- src/parameterizations/lateral/MOM_internal_tides.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index dc0daecd8e..0f951b355a 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -113,6 +113,8 @@ module MOM_internal_tides !< If true, apply scattering due to small-scale roughness as a sink. logical :: apply_Froude_drag !< If true, apply wave breaking as a sink. + real :: En_check_tol !< An energy density tolerance for flagging points with an imbalance in the + !! internal tide energy budget when apply_Froude_drag is True [R Z3 T-2 ~> J m-2] logical :: apply_residual_drag !< If true, apply sink from residual term of reflection/transmission. real, allocatable :: En(:,:,:,:,:) @@ -474,7 +476,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Re-scale (reduce) energy due to breaking CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m)/Fr2_max ! Check (for debugging only) - if (abs(En_new - En_check) > 1e-10*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**2) then + if (abs(En_new - En_check) > CS%En_check_tol) then call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr-breaking.", & all_print=.true.) write(mesg,*) "En_new=", En_new , "En_check=", En_check @@ -485,7 +487,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & Delta_E_check = En_initial - sum(CS%En(i,j,:,fr,m)) TKE_Froude_loss_check = abs(Delta_E_check)/dt TKE_Froude_loss_tot = sum(CS%TKE_Froude_loss(i,j,:,fr,m)) - if (abs(TKE_Froude_loss_check - TKE_Froude_loss_tot) > 1e-10) then + if (abs(TKE_Froude_loss_check - TKE_Froude_loss_tot)*dt > CS%En_check_tol) then call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr energy update.", & all_print=.true.) write(mesg,*) "TKE_Froude_loss_check=", TKE_Froude_loss_check, & @@ -2344,6 +2346,11 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, & "If true, apply wave breaking as a sink.", & default=.false.) + call get_param(param_file, mdl, "EN_CHECK_TOLERANCE", CS%En_check_tol, & + "An energy density tolerance for flagging points with an imbalance in the "//& + "internal tide energy budget when INTERNAL_TIDE_FROUDE_DRAG is True.", & + units="J m-2", default=1.0e-10, scale=US%W_m2_to_RZ3_T3*US%s_to_T, & + do_not_log=.not.CS%apply_Froude_drag) call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress.", & From ecfe8e5c8f4dc44b46a19528919016715040c748 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:14:14 -0500 Subject: [PATCH 107/213] +Add runtime parameter MEKE_LSCALE_MAX_VAL Added the runtime parameters MEKE_LSCALE_MAX_VAL and MEKE_MIN_DEPTH_TOT to specify two previously hard-coded dimensional parameters that are used with some options of the MEKE parameterizations. Also added or amended comments annotating the units of some of the internal variables in the MEKE module. By default, all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for some configurations using the MEKE parameterization. --- src/parameterizations/lateral/MOM_MEKE.F90 | 56 +++++++++++++--------- 1 file changed, 33 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 10d4270202..013cfd386a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -58,7 +58,7 @@ module MOM_MEKE real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [T-1 ~> s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean - !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 + !! eddy velocity, i.e. sqrt(2*MEKE), [nondim]. This should be less than 1 !! to account for the surface intensification of MEKE. real :: MEKE_Cb !< Coefficient in the \f$\gamma_{bot}\f$ expression [nondim] real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed [nondim] @@ -67,17 +67,21 @@ module MOM_MEKE logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC !! framework (Marshall et al., 2012) real :: MEKE_GEOMETRIC_alpha !< The nondimensional coefficient governing the efficiency of the - !! GEOMETRIC thickness diffusion. + !! GEOMETRIC thickness diffusion [nondim]. logical :: MEKE_equilibrium_alt !< If true, use an alternative calculation for the !! equilibrium value of MEKE. logical :: MEKE_equilibrium_restoring !< If true, restore MEKE back to its equilibrium value, !! which is calculated at each time step. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the MEKE GM source term. + real :: MEKE_min_depth_tot !< The minimum total depth over which to distribute MEKE energy + !! sources from GM energy conversion [Z ~> m]. When the total + !! depth is less than this, the sources are scaled away. logical :: Rd_as_max_scale !< If true the length scale can not exceed the !! first baroclinic deformation radius. logical :: use_old_lscale !< Use the old formula for mixing length scale. logical :: use_min_lscale !< Use simple minimum for mixing length scale. + real :: lscale_maxval !< The ceiling on the MEKE mixing length scale when use_min_lscale is true [L ~> m]. real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. real :: MEKE_BGsrc !< Background energy source for MEKE [L2 T-3 ~> W kg-1] (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim] @@ -89,10 +93,10 @@ module MOM_MEKE !! MEKE itself [nondim]. real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral harmonic momentum mixing - !! by unresolved eddies represented by MEKE. + !! by unresolved eddies represented by MEKE [nondim]. real :: viscosity_coeff_Au !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral biharmonic momentum mixing - !! by unresolved eddies represented by MEKE. + !! by unresolved eddies represented by MEKE [nondim]. real :: Lfixed !< Fixed mixing length scale [L ~> m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] @@ -191,7 +195,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2, & ! Ratio of EKE_bottom / EKE [nondim] - tmp, & ! Temporary variable for diagnostic computation + tmp, & ! Temporary variable for computation of diagnostic velocities [L T-1 ~> m s-1] equilibrium_value ! The equilbrium value of MEKE to be calculated at each ! time step [L2 T-2 ~> m2 s-2] @@ -200,20 +204,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! In one place, MEKE_uflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHu, & ! Depth integrated accumulated zonal mass flux [R Z L2 ~> kg]. - drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points [Z T-1 ~> m s-1]. + drag_vel_u ! A (vertical) viscosity associated with bottom drag at u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. ! In one place, MEKE_vflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHv, & ! Depth integrated accumulated meridional mass flux [R Z L2 ~> kg]. - drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points [Z T-1 ~> m s-1]. + drag_vel_v ! A (vertical) viscosity associated with bottom drag at v-points [Z T-1 ~> m s-1]. real :: Kh_here ! The local horizontal viscosity [L2 T-1 ~> m2 s-1] real :: Inv_Kh_max ! The inverse of the local horizontal viscosity [T L-2 ~> s m-2] real :: K4_here ! The local horizontal biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Inv_K4_max ! The inverse of the local horizontal biharmonic viscosity [T L-4 ~> s m-4] - real :: cdrag2 + real :: cdrag2 ! The square of the drag coefficient [nondim] real :: advFac ! The product of the advection scaling factor and 1/dt [T-1 ~> s-1] real :: mass_neglect ! A negligible mass [R Z ~> kg m-2]. real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. @@ -397,7 +399,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & - (GV%Rho0 * MAX(1.0*US%m_to_Z, depth_tot(i,j))) + (GV%Rho0 * MAX(CS%MEKE_min_depth_tot, depth_tot(i,j))) enddo ; enddo else !$OMP parallel do default(shared) @@ -757,10 +759,11 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: SN ! The local Eady growth rate [T-1 ~> s-1] real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim] real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m] - real :: I_H, KhCoeff + real :: I_H ! The inverse of the total column mass, converted to an inverse horizontal length [L-1 ~> m-1] + real :: KhCoeff ! A copy of MEKE_KhCoeff from the control structure [nondim] real :: Kh ! A lateral diffusivity [L2 T-1 ~> m2 s-1] real :: Ubg2 ! Background (tidal?) velocity squared [L2 T-2 ~> m2 s-2] - real :: cd2 + real :: cd2 ! The square of the drag coefficient [nondim] real :: drag_rate ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. real :: src ! The sum of MEKE sources [L2 T-3 ~> W kg-1] real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. @@ -916,7 +919,7 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & ! Local variables real :: SN ! The local Eady growth rate [T-1 ~> s-1] integer :: i, j, is, ie, js, je ! local indices - real :: cd2 ! bottom drag + real :: cd2 ! The square of the drag coefficient [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec cd2 = CS%cdrag**2 @@ -1011,7 +1014,7 @@ end subroutine MEKE_lengthScales !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & +subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1021,10 +1024,8 @@ subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1]. real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. -! real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to -! !! the units for lateral distances (L). - real, intent(out) :: bottomFac2 !< gamma_b^2 - real, intent(out) :: barotrFac2 !< gamma_t^2 + real, intent(out) :: bottomFac2 !< gamma_b^2 [nondim] + real, intent(out) :: barotrFac2 !< gamma_t^2 [nondim] real, intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. real, intent(out) :: Lrhines !< Rhines length scale [L ~> m]. real, intent(out) :: Leady !< Eady length scale [L ~> m]. @@ -1061,7 +1062,7 @@ subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z Leady = 0. endif if (CS%use_min_lscale) then - LmixScale = 1.e7*US%m_to_L + LmixScale = CS%lscale_maxval if (CS%aDeform*Ldeform > 0.) LmixScale = min(LmixScale,CS%aDeform*Ldeform) if (CS%aFrict *Lfrict > 0.) LmixScale = min(LmixScale,CS%aFrict *Lfrict) if (CS%aRhines*Lrhines > 0.) LmixScale = min(LmixScale,CS%aRhines*Lrhines) @@ -1099,10 +1100,10 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this - ! run to the representation in a restart file. + ! run to the representation in a restart file, [nondim]? real :: L_rescale ! A rescaling factor for length from the internal representation in this - ! run to the representation in a restart file. - real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value. + ! run to the representation in a restart file, [nondim]? + real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value [T ~> s] real :: cdrag ! The default bottom drag coefficient [nondim]. character(len=200) :: eke_filename, eke_varname, inputdir character(len=16) :: eke_source_str @@ -1244,6 +1245,10 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & "If true, use the GM energy conversion form S^2*N^2*kappa rather "//& "than the streamfunction for the MEKE GM source term.", default=.false.) + call get_param(param_file, mdl, "MEKE_MIN_DEPTH_TOT", CS%MEKE_min_depth_tot, & + "The minimum total depth over which to distribute MEKE energy sources. "//& + "When the total depth is less than this, the sources are scaled away.", & + units="m", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%GM_src_alt) call get_param(param_file, mdl, "MEKE_VISC_DRAG", CS%visc_drag, & "If true, use the vertvisc_type to calculate the bottom "//& "drag acting on MEKE.", default=.true.) @@ -1262,6 +1267,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "If true, use a strict minimum of provided length scales "//& "rather than harmonic mean.", & default=.false.) + call get_param(param_file, mdl, "MEKE_LSCALE_MAX_VAL", CS%lscale_maxval, & + "The ceiling on the value of the MEKE length scale when MEKE_MIN_LSCALE=True. "//& + "The default is the distance from the equator to the pole on Earth, as "//& + "estimated by enlightenment era scientists, but should probably scale with RAD_EARTH.", & + units="m", default=1.0e7, scale=US%m_to_L, do_not_log=.not.CS%use_min_lscale) call get_param(param_file, mdl, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & "If true, the length scale used by MEKE is the minimum of "//& "the deformation radius or grid-spacing. Only used if "//& From 17ae97b963d08a6a6070b52f194a07da3b88136d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:15:00 -0500 Subject: [PATCH 108/213] +Add runtime parameter MEKE_MIN_DEPTH_DIFF Added the runtime parameter MEKE_MIN_DEPTH_DIFF to specify a previously hard-coded dimensional parameter that is used to constrain the averaging of the horizontal diffusivity used with the MEKE parameterizations. By default, all answers are bitwise identical, but there is a new entries in the MOM_parameter_doc.all files for some configurations. --- .../lateral/MOM_thickness_diffuse.F90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 33492337a7..c0d7e6c50c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -78,6 +78,9 @@ module MOM_thickness_diffuse !! original implementation, while higher values use expressions that !! satisfy rotational symmetry. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. + real :: MEKE_min_depth_diff !< The minimum total depth over which to average the diffusivity + !! used for MEKE [H ~> m or kg m-2]. When the total depth is less + !! than this, the diffusivity is scaled away. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. logical :: use_GM_work_bug !< If true, use the incorrect sign for the @@ -97,9 +100,9 @@ module MOM_thickness_diffuse real, allocatable :: Kh_eta_u(:,:) !< Interface height diffusivities at u points [L2 T-1 ~> m2 s-1] real, allocatable :: Kh_eta_v(:,:) !< Interface height diffusivities in v points [L2 T-1 ~> m2 s-1] - real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] - real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] - real, allocatable, dimension(:,:) :: khth2d !< 2D isopycnal height diffusivity at h-points [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: khth2d(:,:) !< 2D isopycnal height diffusivity at h-points [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -537,7 +540,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(1.0*GV%m_to_H, htot(i,j)) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(CS%MEKE_min_depth_diff, htot(i,j)) enddo ; enddo endif @@ -2157,6 +2160,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, & "If true, uses the thickness diffusivity calculated here to diffuse MEKE.", & default=.false.) + call get_param(param_file, mdl, "MEKE_MIN_DEPTH_DIFF", CS%MEKE_min_depth_diff, & + "The minimum total depth over which to average the diffusivity used for MEKE. "//& + "When the total depth is less than this, the diffusivity is scaled away.", & + units="m", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%Use_KH_in_MEKE) call get_param(param_file, mdl, "USE_GME", CS%use_GME_thickness_diffuse, & "If true, use the GM+E backscatter scheme in association "//& From f4c0bc132516baa5cd3719ad68f9e59e8c577cbb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:15:33 -0500 Subject: [PATCH 109/213] (*)Require dz_subML to calculate the sub-ML N2 Introduced a fatal error when diagnoseMLDbyDensityDifference is directed to calculate the mean stratification in a region below the mixed layer but dz_subML is not provided as the depth extent over which to average the stratification, replacing the previous hard coded (but unused) default value of 50 m. Also replaced a hard coded floor on the minimum thickness over which to apply boundary fluxes of 1e-30 m in applyBoundaryFluxesInOut with GV%H_subroundoff, which is also a tiny value. This floor is here just to avoid division by 0; while it is possible for this to change answers in some cases where ANGSTROM=0, even then there are other limiters that should apply so the solutions should not change. All answers are bitwise identical with for the MOM6-examples test suite, and very likely for all existing MOM6 configurations. --- .../vertical/MOM_diabatic_aux.F90 | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index d51f796df1..c004b63d11 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -694,12 +694,21 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ - id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%L_to_Z**2*GV%g_Earth / (GV%Rho0) - dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML + id_N2 = -1 + if (present(id_N2subML)) then + if (present(dz_subML)) then + id_N2 = id_N2subML + dH_subML = GV%Z_to_H*dz_subML + else + call MOM_error(FATAL, "When the a diagnostic of the subML stratification is "//& + "requested by providing id_N2_subML to diagnoseMLDbyDensityDifference, "//& + "the distance over which to calculate that distance must also be provided.") + endif + endif + + gE_rho0 = US%L_to_Z**2*GV%g_Earth / GV%Rho0 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1146,7 +1155,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom_H, 1.0e-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, GV%H_subroundoff) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. From 391ddba15fbd15895057d2f36198d43ec6093344 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:16:45 -0500 Subject: [PATCH 110/213] +Add runtime parameter KD_SEED_KAPPA_SHEAR Added the new runtime parameter KD_SEED_KAPPA_SHEAR to specify a previously hard-coded dimensional parameter used in the MOM_kappa_shear module. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for configurations with USE_JACKSON_PARAM = True. --- src/parameterizations/vertical/MOM_kappa_shear.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 590711bc2c..a1a5a22322 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -54,6 +54,10 @@ module MOM_kappa_shear !! equation, 0 to eliminate the shear scale [nondim]. real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: kappa_0 !< The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: kappa_seed !< A moderately large seed value of diapycnal diffusivity that + !! is used as a starting turbulent diffusivity in the iterations + !! to findind an energetically constrained solution for the + !! shear-driven diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_trunc !< Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated [nondim]. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity [nondim]. @@ -270,7 +274,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - do K=1,nzc+1 ; kappa(K) = 1.0*US%m2_s_to_Z2_T ; enddo + do K=1,nzc+1 ; kappa(K) = CS%kappa_seed ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -537,7 +541,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - do K=1,nzc+1 ; kappa(K) = 1.0*US%m2_s_to_Z2_T ; enddo + do K=1,nzc+1 ; kappa(K) = CS%kappa_seed ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -1787,6 +1791,11 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "diffusivities. The default is the greater of KD and 1e-7 m2 s-1.", & units="m2 s-1", default=kappa_0_default*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, & do_not_log=just_read) + call get_param(param_file, mdl, "KD_SEED_KAPPA_SHEAR", CS%kappa_seed, & + "A moderately large seed value of diapycnal diffusivity that is used as a "//& + "starting turbulent diffusivity in the iterations to find an energetically "//& + "constrained solution for the shear-driven diffusivity.", & + units="m2 s-1", default=1.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_TRUNC_KAPPA_SHEAR", CS%kappa_trunc, & "The value of shear-driven diffusivity that is considered negligible "//& "and is rounded down to 0. The default is 1% of KD_KAPPA_SHEAR_0.", & From 1db93d3330d42bec12251b5055d42841345ba772 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 28 Dec 2022 09:17:10 -0500 Subject: [PATCH 111/213] +Add runtime parameter ENTRAIN_DIFFUSIVE_MAX_ENT Added the new runtime parameter ENTRAIN_DIFFUSIVE_MAX_ENT to specify a previously hard-coded upper limit on the rate of entrainment in the buffer layers with a bulk mixed layer in the MOM_entrainment_diffusive module. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for some layer-mode configurations with a bulk mixed layer. --- .../vertical/MOM_entrain_diffusive.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 9e749874c3..332321b209 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -34,6 +34,9 @@ module MOM_entrain_diffusive !! calculate the diapycnal entrainment. real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values !! [H ~> m or kg m-2]. + real :: max_Ent !< A large ceiling on the maximum permitted amount of entrainment + !! across each interface between the mixed and buffer layers within + !! a timestep [H ~> m or kg m-2]. real :: Rho_sig_off !< The offset between potential density and a sigma value [R ~> kg m-3] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -1053,7 +1056,6 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, real, dimension(SZI_(G), SZK_(GV)) :: & S_est ! An estimate of the coordinate potential density - 1000 after ! entrainment for each layer [R ~> kg m-3]. - real :: max_ent ! The maximum possible entrainment [H ~> m or kg m-2]. real :: dh ! An available thickness [H ~> m or kg m-2]. real :: Kd_x_dt ! The diffusion that remains after thin layers are ! entrained [H2 ~> m2 or kg2 m-4]. @@ -1063,8 +1065,6 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = GV%ke -! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems. - max_ent = 1.0e4*GV%m_to_H h_neglect = GV%H_subroundoff do i=is,ie ; pres(i) = tv%P_Ref ; enddo @@ -1084,8 +1084,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, do k=2,kmb ; do i=is,ie if (do_i(i)) then - Ent_bl(i,K) = min(2.0 * dtKd_int(i,K) / (h(i,j,k-1) + h(i,j,k) + h_neglect), & - max_ent) + Ent_bl(i,K) = min(2.0 * dtKd_int(i,K) / (h(i,j,k-1) + h(i,j,k) + h_neglect), CS%max_Ent) else ; Ent_bl(i,K) = 0.0 ; endif enddo ; enddo @@ -2116,6 +2115,10 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re "The tolerance with which to solve for entrainment values.", & units="m", default=US%Z_to_m*MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H, & do_not_log=just_read_params) + call get_param(param_file, mdl, "ENTRAIN_DIFFUSIVE_MAX_ENT", CS%max_Ent, & + "A large ceiling on the maximum permitted amount of entrainment across each "//& + "interface between the mixed and buffer layers within a timestep.", & + units="m", default=1.0e4, scale=GV%m_to_H, do_not_log=.not.CS%bulkmixedlayer) CS%Rho_sig_off = 1000.0*US%kg_m3_to_R From 42051fca7c8486a1c49780aac545be41e7e3c294 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 29 Dec 2022 10:10:13 -0500 Subject: [PATCH 112/213] +Add runtime parameter KPP_LT_MLD_GUESS_MIN Added the new runtime parameter KPP_LT_MLD_GUESS_MIN to specify a previously hard-coded lower limit on the estimate of the boundary layer depth used to calculate the Langmuir number for some options with KPP. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for some configurations with a KPP and Langmuir enhanced turbulence. --- .../vertical/MOM_CVMix_KPP.F90 | 35 ++++++++++--------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index d1d4b1c790..3ac31ef466 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -113,6 +113,9 @@ module MOM_CVMix_KPP logical :: LT_Vt2_Enhancement !< Flags if enhancing Vt2 due to LT integer :: LT_VT2_METHOD !< Integer for Vt2 LT method real :: KPP_VT2_ENH_FAC !< Factor to multiply by VT2 if Method is CONSTANT [nondim] + real :: MLD_guess_min !< The minimum estimate of the mixed layer depth used to + !! calculate the Langmuir number for Langmuir turbulence + !! enhancement with KPP [Z ~> m] logical :: STOKES_MIXING !< Flag if model is mixing down Stokes gradient !! This is relevant for which current to use in RiB @@ -460,6 +463,13 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) endif endif + if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then + call get_param(paramFile, mdl, "KPP_LT_MLD_GUESS_MIN", CS%MLD_guess_min, & + "The minimum estimate of the mixed layer depth used to calculate "//& + "the Langmuir number for Langmuir turbulence enhancement with KPP.", & + units="m", default=1.0, scale=US%m_to_Z) + endif + call closeParameterBlock(paramFile) call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) @@ -658,10 +668,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! loop over horizontal points on processor do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip calling KPP for land points - if (G%mask2dT(i,j)==0.) cycle + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then ! things independent of position within the column surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) @@ -869,7 +876,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! end of the horizontal do-loops over the vertical columns - enddo ! i + endif ; enddo ! i enddo ! j call cpu_clock_end(id_clock_KPP_calc) @@ -1000,10 +1007,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & !$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult) do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip calling KPP for land points - if (G%mask2dT(i,j)==0.) cycle + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then do k=1,GV%ke U_H(k) = 0.5 * (u(i,j,k)+u(i-1,j,k)) @@ -1120,10 +1124,10 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl enddo ! k-loop finishes if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then - MLD_guess = max( 1.*US%m_to_Z, abs(CS%OBLdepthprev(i,j) ) ) + MLD_guess = max( CS%MLD_guess_min, abs(CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) - CS%La_SL(i,j)=LA + CS%La_SL(i,j) = LA endif @@ -1265,7 +1269,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV - enddo + endif ; enddo enddo call cpu_clock_end(id_clock_KPP_compute_BLD) @@ -1326,10 +1330,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h) !$OMP parallel do default(none) shared(G, GV, US, CS, h, OBLdepth_prev) & !$OMP private(wc, ww, we, wn, ws, dh, hcorr, cellHeight, iFaceHeight) do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip land points - if (G%mask2dT(i,j)==0.) cycle + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. @@ -1363,7 +1364,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h) ! prevent OBL depths deeper than the bathymetric depth CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - enddo + endif ; enddo enddo enddo ! s-loop From 4e5f7408fde9515d4e09aaa8f51679a98a344f6f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 Jan 2023 10:57:32 -0500 Subject: [PATCH 113/213] +Add runtime parameter REG_SFC_SUFFICIENT_ADJ Added the new runtime parameter REG_SFC_SUFFICIENT_ADJ to specify a previously hard-coded fraction of the target net entrainment to the mixed and buffer layers that is enough to stop the search for additional mass from the interior layers when regularizing the near-surface layers in layer-mode configurations. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for some layer-mode configurations with REGULARIZE_SURFACE_LAYERS=True. --- .../vertical/MOM_regularize_layers.F90 | 29 ++++++++++++------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 8966c12b79..bb81d367c6 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -34,6 +34,10 @@ module MOM_regularize_layers real :: density_match_tol !< A relative tolerance for how well the densities must match !! with the target densities during detrainment when regularizing !! the near-surface layers [nondim] + real :: sufficient_adjustment !< The fraction of the target entrainment of mass to the mixed + !! and buffer layers that is enough for one timestep when regularizing + !! the near-surface layers [nondim]. No more mass will be sought from + !! deeper layers in the interior after this fraction is exceeded. real :: h_def_tol1 !< The value of the relative thickness deficit at !! which to start modifying the structure, 0.5 by !! default (or a thickness ratio of 5.83) [nondim]. @@ -75,7 +79,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a @@ -86,7 +90,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control structure if (.not. CS%initialized) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") @@ -107,7 +111,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a @@ -118,7 +122,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control structure ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -149,7 +153,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real, dimension(SZI_(G)) :: & p_ref_cv, & ! Reference pressure for the potential density which defines ! the coordinate variable, set to P_Ref [R L2 T-2 ~> Pa]. - Rcv_tol, & ! A tolerence, relative to the target density differences + Rcv_tol, & ! A tolerance, relative to the target density differences ! between layers, for detraining into the interior [nondim]. h_add_tgt, & ! The target for the thickness to add to the mixed layers [H ~> m or kg m-2] h_add_tot, & ! The net thickness added to the mixed layers [H ~> m or kg m-2] @@ -161,7 +165,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real :: I_dtol ! The inverse of the tolerance changes [nondim]. real :: I_dtol34 ! The inverse of the tolerance changes [nondim]. real :: e_e, e_w, e_n, e_s ! Temporary interface heights [H ~> m or kg m-2]. - real :: wt ! The weight of the filted interfaces in setting the targets [nondim]. + real :: wt ! The weight of the filtered interfaces in setting the targets [nondim]. real :: scale ! A scaling factor [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -321,7 +325,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) S_2d(i,nkmb) = (h_prev*S_2d(i,nkmb) + h_add*S_2d(i,k)) / h_2d(i,nkmb) if ((e_2d(i,nkmb+1) <= e_filt(i,nkmb+1)) .or. & - (h_add_tot(i) > 0.6*h_add_tgt(i))) then !### 0.6 is adjustable?. + (h_add_tot(i) > CS%sufficient_adjustment*h_add_tgt(i))) then more_ent_i(i) = .false. else cols_left = .true. @@ -602,7 +606,7 @@ end subroutine regularize_surface !> This subroutine determines the amount by which the harmonic mean !! thickness at velocity points differ from the arithmetic means, relative to -!! the the arithmetic means, after eliminating thickness variations that are +!! the arithmetic means, after eliminating thickness variations that are !! solely due to topography and aggregating all interior layers into one. subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -615,7 +619,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) real, dimension(SZI_(G),SZJB_(G)), & intent(out) :: def_rat_v !< The thickness deficit ratio at v points, !! [nondim]. - type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -710,7 +714,7 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate !! diagnostic output. - type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control structure # include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. @@ -748,6 +752,11 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) "densities during detrainment when regularizing the near-surface layers. The "//& "default of 0.6 gives 20% overlaps in density", & units="nondim", default=0.6, do_not_log=just_read) + call get_param(param_file, mdl, "REG_SFC_SUFFICIENT_ADJ", CS%sufficient_adjustment, & + "The fraction of the target entrainment of mass to the mixed and buffer layers "//& + "that is enough for one timestep when regularizing the near-surface layers. "//& + "No more mass will be sought from deeper layers in the interior after this "//& + "fraction is exceeded.", units="nondim", default=0.6, do_not_log=just_read) call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & default=99991231, do_not_log=just_read) From 44f4be420e9723a7bbda1a5f5008428c00cd8186 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 Jan 2023 11:01:47 -0500 Subject: [PATCH 114/213] +Add runtime parameter SALT_EXTRACTION_LIMIT Added the new runtime parameter SALT_EXTRACTION_LIMIT to specify a previously hard-coded limit on the fraction of the salt in a layer that can be extracted by the surface fluxes within a timestep. Also added do_not_log flags based on the value of ENABLE_THERMODYNAMICS to avoid logging parameters that are only used if thermodynamics are active in cases when it is not. In addition, the doxygen trailer describing this module had been inappropriately borrowed from another module, so it was completely rewritten to describe what the routines in this module actually do. The missing doxygen description of set_pen_shortwave was also added, and a number of spelling errors in comments were corrected. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files for some configurations and meaningless entries have been removed from others. --- .../vertical/MOM_diabatic_aux.F90 | 132 ++++++++++-------- 1 file changed, 76 insertions(+), 56 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index c004b63d11..ba8ba0b805 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -43,6 +43,8 @@ module MOM_diabatic_aux logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the !! river mouths to a depth of "rivermix_depth" real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T [Z ~> m]. + real :: dSalt_frac_max !< An upper limit on the fraction of the salt in a layer that can be + !! lost to the net surface salt fluxes within a timestep [nondim] logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is true. @@ -220,7 +222,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) end subroutine make_frazil !> This subroutine applies double diffusion to T & S, assuming no diapycnal mass -!! fluxes, using a simple triadiagonal solver. +!! fluxes, using a simple tridiagonal solver. subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -507,7 +509,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring velocity points [nondim] real :: a_e(SZI_(G)), a_w(SZI_(G)) ! Fractional weights of the neighboring velocity points [nondim] real :: sum_area ! A sum of adjacent areas [L2 ~> m2] - real :: Idenom ! The inverse of the denomninator in a weighted average [L-2 ~> m-2] + real :: Idenom ! The inverse of the denominator in a weighted average [L-2 ~> m-2] logical :: mix_vertically, zero_mixing integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -594,12 +596,15 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) call cpu_clock_end(id_clock_uv_at_h) end subroutine find_uv_at_h - +!> Estimate the optical properties of the water column and determine the penetrating shortwave +!! radiation by band, extracting the relevant information from the fluxes type and storing it +!! in the optics type for later application. This routine is effectively a wrapper for +!! set_opacity with added error handling and diagnostics. subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity, tracer_flow_CSp) type(optics_type), pointer :: optics !< An optics structure that has will contain !! information about shortwave fluxes and absorption. type(forcing), intent(inout) :: fluxes !< points to forcing fields - !! unused fields have NULL ptrs + !! unused fields have NULL pointers type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -702,7 +707,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, id_N2 = id_N2subML dH_subML = GV%Z_to_H*dz_subML else - call MOM_error(FATAL, "When the a diagnostic of the subML stratification is "//& + call MOM_error(FATAL, "When the diagnostic of the subML stratification is "//& "requested by providing id_N2_subML to diagnoseMLDbyDensityDifference, "//& "the distance over which to calculate that distance must also be provided.") endif @@ -737,10 +742,10 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! the cells that extend over at least dz_subML. if (id_N2>0) then do i=is,ie - if (MLD(i,j)==0.0) then ! Still in the mixed layer. + if (MLD(i,j) == 0.0) then ! Still in the mixed layer. H_subML(i) = H_subML(i) + h(i,j,k) elseif (.not.N2_region_set(i)) then ! This block is below the mixed layer, but N2 has not been found yet. - if (dH_N2(i)==0.0) then ! Record the temperature, salinity, pressure, immediately below the ML + if (dH_N2(i) == 0.0) then ! Record the temperature, salinity, pressure, immediately below the ML T_subML(i) = tv%T(i,j,k) ; S_subML(i) = tv%S(i,j,k) H_subML(i) = H_subML(i) + 0.5 * h(i,j,k) ! Start midway through this layer. dH_N2(i) = 0.5 * h(i,j,k) @@ -761,8 +766,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, do i = is, ie deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) - if ((MLD(i,j)==0.) .and. (ddRho>0.) .and. & - (deltaRhoAtKm1(i)=densityDiff)) then + if ((MLD(i,j) == 0.) .and. (ddRho > 0.) .and. & + (deltaRhoAtKm1(i) < densityDiff) .and. (deltaRhoAtK(i) >= densityDiff)) then aFac = ( densityDiff - deltaRhoAtKm1(i) ) / ddRho MLD(i,j) = dK(i) * aFac + dKm1(i) * (1. - aFac) endif @@ -770,7 +775,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo ! i-loop enddo ! k-loop do i=is,ie - if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0) then ! Now actually calculate stratification, N2, below the mixed layer. @@ -1293,7 +1298,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! B/ update mass, salt, temp from mass leaving ocean. ! C/ update temp due to penetrative SW do i=is,ie - if (G%mask2dT(i,j)>0.) then + if (G%mask2dT(i,j) > 0.) then ! A/ Update mass, temp, and salinity due to incoming mass flux. do k=1,1 @@ -1333,7 +1338,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! where River is in units of [Z T-1 ~> m s-1]. ! Samb = Ambient salinity at the mouth of the estuary ! rivermix_depth = The prescribed depth over which to mix river inflow - ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. + ! drho_ds = The derivative of density with salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) if (GV%Boussinesq) then RivermixConst = -0.5*(CS%rivermix_depth*dt) * ( US%L_to_Z**2*GV%g_Earth ) * GV%Rho0 @@ -1384,8 +1389,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) dTemp = fractionOfForcing*netHeat(i) - ! ### The 0.9999 here should become a run-time parameter? - dSalt = max( fractionOfForcing*netSalt(i), -0.9999*h2d(i,k)*tv%S(i,j,k)) + dSalt = max( fractionOfForcing*netSalt(i), -CS%dSalt_frac_max * h2d(i,k) * tv%S(i,j,k)) ! Update the forcing by the part to be consumed within the present k-layer. ! If fractionOfForcing = 1, then new netMassOut vanishes. @@ -1441,7 +1445,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t enddo ! k ! Check if trying to apply fluxes over land points - elseif ((abs(netHeat(i))+abs(netSalt(i))+abs(netMassIn(i))+abs(netMassOut(i)))>0.) then + elseif ((abs(netHeat(i)) + abs(netSalt(i)) + abs(netMassIn(i)) + abs(netMassOut(i))) > 0.) then if (.not. CS%ignore_fluxes_over_land) then call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (land)') @@ -1579,7 +1583,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (CS%id_nonpenSW_diag > 0) call post_data(CS%id_nonpenSW_diag , CS%nonpenSW_diag , CS%diag) ! The following check will be ignored if ignore_fluxes_over_land = true - if (numberOfGroundings>0 .and. .not. CS%ignore_fluxes_over_land) then + if ((numberOfGroundings > 0) .and. .not.CS%ignore_fluxes_over_land) then do i = 1, min(numberOfGroundings, maxGroundings) call forcing_SinglePointPrint(fluxes,G,iGround(i),jGround(i),'applyBoundaryFluxesInOut (grounding)') write(mesg(1:45),'(3es15.3)') G%geoLonT( iGround(i), jGround(i) ), & @@ -1613,8 +1617,8 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori !! boundary layer scheme to determine the diffusivity !! in the surface boundary layer. -! This "include" declares and sets the variable "version". -#include "version_variable.h" + ! This "include" declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=200) :: inputdir ! The directory where NetCDF input files character(len=240) :: chl_filename ! A file from which chl_a concentrations are to be read. @@ -1642,28 +1646,31 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori "The following parameters are used for auxiliary diabatic processes.") call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & - "If true, temperature and salinity are used as state "//& - "variables.", default=.true.) + "If true, temperature and salinity are used as state variables.", default=.true.) call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any "//& "overlying layers down to the freezing point, thereby "//& "avoiding the creation of thin ice when the SST is above "//& - "the freezing point.", default=.true.) - call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", & - CS%pressure_dependent_frazil, & + "the freezing point.", default=.true., do_not_log=.not.use_temperature) + call get_param(param_file, mdl, "SALT_EXTRACTION_LIMIT", CS%dSalt_frac_max, & + "An upper limit on the fraction of the salt in a layer that can be lost to the "//& + "net surface salt fluxes within a timestep.", & + units="nondim", default=0.9999, do_not_log=.not.use_temperature) + CS%dSalt_frac_max = max(min(CS%dSalt_frac_max, 1.0), 0.0) + call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", CS%pressure_dependent_frazil, & "If true, use a pressure dependent freezing temperature "//& "when making frazil. The default is false, which will be "//& "faster but is inappropriate with ice-shelf cavities.", & - default=.false.) + default=.false., do_not_log=.not.use_temperature) if (use_ePBL) then call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& - "If true, the model does not check if fluxes are being applied "//& - "over land points. This is needed when the ocean is coupled "//& - "with ice shelves and sea ice, since the sea ice mask needs to "//& - "be different than the ocean mask to avoid sea ice formation "//& - "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) + "If true, the model does not check if fluxes are being applied "//& + "over land points. This is needed when the ocean is coupled "//& + "with ice shelves and sea ice, since the sea ice mask needs to "//& + "be different than the ocean mask to avoid sea ice formation "//& + "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & "If true, apply additional mixing wherever there is "//& "runoff, so that it is mixed down to RIVERMIX_DEPTH "//& @@ -1680,11 +1687,11 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & - default=.false.) + default=.false., do_not_log=.not.use_temperature) call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & "If true, use the fluxes%calving_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & - default=.false.) + default=.false., do_not_log=.not.use_temperature) else CS%use_river_heat_content = .false. CS%use_calving_heat_content = .false. @@ -1778,32 +1785,45 @@ end subroutine diabatic_aux_end !> \namespace mom_diabatic_aux !! -!! This module contains the subroutines that, along with the -!! subroutines that it calls, implements diapycnal mass and momentum -!! fluxes and a bulk mixed layer. The diapycnal diffusion can be -!! used without the bulk mixed layer. +!! This module contains subroutines that apply various diabatic processes. Usually these +!! subroutines are called from the MOM_diabatic module. All of these routines use appropriate +!! limiters or logic to work properly with arbitrary layer thicknesses (including massless layers) +!! and an arbitrarily large timestep. +!! +!! The subroutine make_frazil facilitates the formation of frazil ice when the ocean water +!! drops below the in situ freezing point by heating the water to the freezing point and +!! accumulating the required heat for exchange with the sea-ice module. +!! +!! The subroutine adjust_salt adds salt as necessary to keep the salinity above a +!! specified minimum value, and keeps track of the cumulative additions. If the minimum +!! salinity is the natural value of 0, this routine should never do anything. +!! +!! The subroutine differential_diffuse_T_S solves a pair of tridiagonal equations for +!! the diffusion of temperatures and salinities with differing diffusivities. +!! +!! The subroutine triDiagTS solves a tridiagonal equations for the evolution of temperatures +!! and salinities due to net entrainment by layers and a diffusion with the same diffusivity. +!! +!! The subroutine triDiagTS_Eulerian solves a tridiagonal equations for the evolution of +!! temperatures and salinities due to diffusion with the same diffusivity, but no net entrainment. +!! +!! The subroutine find_uv_at_h interpolates velocities to thickness points, optionally also +!! using tridiagonal equations to solve for the impacts of net entrainment or mixing of +!! momentum between layers. +!! +!! The subroutine set_pen_shortwave determines the optical properties of the water column and +!! the net shortwave fluxes, and stores them in the optics type, working via calls to set_opacity. +!! +!! The subroutine diagnoseMLDbyDensityDifference diagnoses a mixed layer depth based on a +!! density difference criterion, and may also estimate the stratification of the water below +!! this diagnosed mixed layer. !! -!! diabatic first determines the (diffusive) diapycnal mass fluxes -!! based on the convergence of the buoyancy fluxes within each layer. -!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, -!! 1997) is used for combined diapycnal advection and diffusion, -!! calculated implicitly and potentially with the Richardson number -!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal -!! advection is fundamentally the residual of diapycnal diffusion, -!! so the fully implicit upwind differencing scheme that is used is -!! entirely appropriate. The downward buoyancy flux in each layer -!! is determined from an implicit calculation based on the previously -!! calculated flux of the layer above and an estimated flux in the -!! layer below. This flux is subject to the following conditions: -!! (1) the flux in the top and bottom layers are set by the boundary -!! conditions, and (2) no layer may be driven below an Angstrom thick- -!! ness. If there is a bulk mixed layer, the buffer layer is treat- -!! ed as a fixed density layer with vanishingly small diffusivity. +!! The subroutine diagnoseMLDbyEnergy diagnoses a mixed layer depth based on a mixing-energy +!! criterion, as described by Reichl et al., 2022, JGR: Oceans, doi:10.1029/2021JC018140. !! -!! diabatic takes 5 arguments: the two velocities (u and v), the -!! thicknesses (h), a structure containing the forcing fields, and -!! the length of time over which to act (dt). The velocities and -!! thickness are taken as inputs and modified within the subroutine. -!! There is no limit on the time step. +!! The subroutine applyBoundaryFluxesInOut updates the layer thicknesses, temperatures and +!! salinities due to the application of the surface forcing. It may also calculate the implied +!! turbulent kinetic energy requirements for this forcing to be mixed over the model's finite +!! vertical resolution in the surface layers. end module MOM_diabatic_aux From 7e2c427404ffdeb0e0c45c68a2d845c95b5f4d61 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 Jan 2023 11:10:38 -0500 Subject: [PATCH 115/213] +Add runtime parameter MECH_TKE_FLOOR Added the new runtime parameter MECH_TKE_FLOOR to specify a previously hard-coded tiny positive value for the remaining TKE when the bulk mixed does not yet have HMIX_MIN of fluid during mechanical entrainment. By default all answers are bitwise identical, but the MOM_parameter_doc.all files for some configurations with a bulk mixed layer and HMIX_MIN > 0 have a new entry. --- .../vertical/MOM_bulk_mixed_layer.F90 | 25 +++++++++++++------ 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index cb17884ee7..9d118f9096 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -51,6 +51,10 @@ module MOM_bulk_mixed_layer !! released mean kinetic energy becomes TKE [nondim]. real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. + real :: mech_TKE_floor !< A tiny floor on the amount of turbulent kinetic energy that is + !! used when the mixed layer does not yet contain HMIX_MIN fluid + !! [Z L2 T-2 ~> m3 s-2]. The default is so small that its actual + !! value is irrelevant, but it is detectably greater than 0. real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to !! avoid boiling the ocean. @@ -1633,8 +1637,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif TKE(i) = TKE_full_ent - !### The minimum TKE value in this line may be problematically small. - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z*US%m_s_to_L_T**2 + + if (TKE(i) <= 0.0) TKE(i) = CS%mech_TKE_floor else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -2406,7 +2410,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, R0(i,kb2) = R0(i,kb1) - Rcv(i,kb2)=Rcv(i,kb1) ; T(i,kb2)=T(i,kb1) ; S(i,kb2)=S(i,kb1) + Rcv(i,kb2) = Rcv(i,kb1) ; T(i,kb2) = T(i,kb1) ; S(i,kb2) = S(i,kb1) if (k1 <= nz) then ; if (R0(i,k1) >= R0(i,kb1)) then @@ -3175,9 +3179,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! the released buoyancy. With multiple buffer layers, much more ! graceful options are available. do i=is,ie ; if (h(i,nkmb) > 0.0) then - if ((R0(i,0) & - (R0(i,nkmb)-R0(i,nz))*h(i,nkmb)) then + if ((R0(i,0) < R0(i,nz)) .and. (R0(i,nz) < R0(i,nkmb))) then + if ((R0(i,nz)-R0(i,0))*h(i,0) > (R0(i,nkmb)-R0(i,nz))*h(i,nkmb)) then detrain(i) = (R0(i,nkmb)-R0(i,nz))*h(i,nkmb) / (R0(i,nkmb)-R0(i,0)) else detrain(i) = (R0(i,nz)-R0(i,0))*h(i,0) / (R0(i,nkmb)-R0(i,0)) @@ -3220,7 +3223,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e do k=nz-1,nkmb+1,-1 ; do i=is,ie if (splittable_BL(i)) then - if (RcvTgt(k)<=Rcv(i,nkmb)) then + if (RcvTgt(k) <= Rcv(i,nkmb)) then ! Estimate dR/drho, dTheta/dR, and dS/dR, where R is the coordinate variable ! and rho is in-situ (or surface) potential density. ! There is no "right" way to do this, so this keeps things reasonable, if @@ -3320,7 +3323,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * dR0_dRcv * & (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - Rcv(i,nkmb) + dRml) endif - endif ! RcvTgt(k)<=Rcv(i,nkmb) + endif ! (RcvTgt(k) <= Rcv(i,nkmb)) endif ! splittable_BL enddo ; enddo ! i & k loops @@ -3422,6 +3425,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "The minimum mixed layer depth if the mixed layer depth "//& "is determined dynamically.", units="m", default=0.0, scale=US%m_to_Z) CS%Hmix_min = GV%Z_to_H * Hmix_min_Z + call get_param(param_file, mdl, "MECH_TKE_FLOOR", CS%mech_TKE_floor, & + "A tiny floor on the amount of turbulent kinetic energy that is used when "//& + "the mixed layer does not yet contain HMIX_MIN fluid. The default is so "//& + "small that its actual value is irrelevant, so long as it is greater than 0.", & + units="m3 s-2", default=1.0e-150, scale=US%m_to_Z*US%m_s_to_L_T**2, & + do_not_log=(Hmix_min_Z<=0.0)) call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers "//& From 3cecac4dc7a67aadc4bc73ca7ac0e3bc5e0522dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 Jan 2023 18:22:06 -0500 Subject: [PATCH 116/213] +Add runtime parameter VARYING_SPONGE_MASK_THICKNESS Added the new runtime parameter VARYING_SPONGE_MASK_THICKNESS to specify a previously hard-coded input file thickness below which the target values in time-varying sponges are replaced with those from the layer above. By default all answers are bitwise identical, but the MOM_parameter_doc.all files for configurations with time-varying sponges have a new entry. --- .../vertical/MOM_ALE_sponge.F90 | 42 +++++++++++-------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 740c42f16a..7ff3bd3701 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -131,7 +131,10 @@ module MOM_ALE_sponge !! been rearranged for rotational invariance. logical :: time_varying_sponges !< True if using newer sponge code - logical :: spongeDataOngrid !< True if the sponge data are on the model horizontal grid + logical :: spongeDataOngrid !< True if the sponge data are on the model horizontal grid + real :: varying_input_h_mask !< An input file thickness below which the target values with time-varying + !! sponges are replaced by the value above [H ~> m or kg m-2]. + !! It is not clear why this needs to be greater than 0. !>@{ Diagnostic IDs integer, dimension(MAX_FIELDS_) :: id_sp_tendency !< Diagnostic ids for tracers @@ -444,7 +447,7 @@ end subroutine get_ALE_sponge_thicknesses subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Iresttime_u_in, Iresttime_v_in) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: Iresttime !< The inverse of the restoring time [T-1 ~> s-1]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse !! for model parameter values. @@ -502,6 +505,11 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "than PCM. E.g., if PPM is used for remapping, a "//& "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "VARYING_SPONGE_MASK_THICKNESS", CS%varying_input_h_mask, & + "An input file thickness below which the target values with "//& + "time-varying sponges are replaced by the value above.", & + units="m", default=0.001, scale=GV%m_to_H) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & default=99991231) @@ -893,7 +901,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename else CS%Ref_val_u%id = init_external_field(filename_u, fieldname_u) endif - fld_sz(1:4)=-1 + fld_sz(1:4) = -1 call get_external_field_info(CS%Ref_val_u%id, size=fld_sz) CS%Ref_val_u%nz_data = fld_sz(3) CS%Ref_val_u%num_tlevs = fld_sz(4) @@ -904,7 +912,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename else CS%Ref_val_v%id = init_external_field(filename_v, fieldname_v) endif - fld_sz(1:4)=-1 + fld_sz(1:4) = -1 call get_external_field_info(CS%Ref_val_v%id, size=fld_sz) CS%Ref_val_v%nz_data = fld_sz(3) CS%Ref_val_v%num_tlevs = fld_sz(4) @@ -943,20 +951,20 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real, allocatable, dimension(:,:,:) :: mask_u ! A temporary array for field mask at u pts [nondim] real, allocatable, dimension(:,:,:) :: mask_v ! A temporary array for field mask at v pts [nondim] real, allocatable, dimension(:,:,:) :: tmp !< A temporary array for thermodynamic sponge tendency - !! diagnostics [various] + !! diagnostics [various] then in [various T-1 ~> various s-1] real, allocatable, dimension(:,:,:) :: tmp_u !< A temporary array for u sponge acceleration diagnostics !! first in [L T-1 ~> m s-1] then in [L T-2 ~> m s-2] real, allocatable, dimension(:,:,:) :: tmp_v !< A temporary array for v sponge acceleration diagnostics !! first in [L T-1 ~> m s-1] then in [L T-2 ~> m s-2] real, dimension(:), allocatable :: hsrc ! Source thicknesses [Z ~> m]. ! Local variables for ALE remapping - real, dimension(:), allocatable :: tmpT1d + real, dimension(:), allocatable :: tmpT1d ! A temporary variable for ALE remapping [various] integer :: c, m, i, j, k, is, ie, js, je, nz, nz_data real, allocatable, dimension(:), target :: z_in ! The depths (positive downward) in the input file [Z ~> m] real, allocatable, dimension(:), target :: z_edges_in ! The depths (positive downward) of the ! edges in the input file [Z ~> m] real :: missing_value ! The missing value in the input data field [various] - real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] real :: zTopOfCell, zBottomOfCell ! Interface heights (positive upward) in the input dataset [Z ~> m]. real :: sp_val_u ! Interpolation of sp_val to u-points, often a velocity in [L T-1 ~> m s-1] @@ -986,6 +994,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) allocate( hsrc(nz_data) ) allocate( tmpT1d(nz_data) ) do c=1,CS%num_col + ! Set i and j to the structured indices of column c. i = CS%col_i(c) ; j = CS%col_j(c) CS%Ref_val(m)%p(1:nz_data,c) = sp_val(i,j,1:nz_data) ! Build the source grid @@ -1001,7 +1010,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) tmpT1d(k) = -99.9 endif hsrc(k) = zTopOfCell - zBottomOfCell - if (hsrc(k)>0.) nPoints = nPoints + 1 + if (hsrc(k) > 0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model @@ -1009,7 +1018,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) CS%Ref_val(m)%h(1:nz_data,c) = GV%Z_to_H*hsrc(1:nz_data) CS%Ref_val(m)%p(1:nz_data,c) = tmpT1d(1:nz_data) do k=2,nz_data - if (CS%Ref_val(m)%h(k,c) <= 0.001*GV%m_to_H) & + if (CS%Ref_val(m)%h(k,c) <= CS%varying_input_h_mask) & ! some confusion here about why the masks are not correct returning from horiz_interp ! reverting to using a minimum thickness criteria CS%Ref_val(m)%p(k,c) = CS%Ref_val(m)%p(k-1,c) @@ -1027,14 +1036,13 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) allocate(tmp(G%isd:G%ied,G%jsd:G%jed,nz), source=0.0) endif do c=1,CS%num_col - ! c is an index for the next 3 lines but a multiplier for the rest of the loop - ! Therefore we use c as per C code and increment the index where necessary. + ! Set i and j to the structured indices of column c. i = CS%col_i(c) ; j = CS%col_j(c) damp = dt * CS%Iresttime_col(c) I1pdamp = 1.0 / (1.0 + damp) tmp_val2(1:nz_data) = CS%Ref_val(m)%p(1:nz_data,c) do k=1,nz - h_col(k)=h(i,j,k) + h_col(k) = h(i,j,k) enddo if (CS%time_varying_sponges) then @@ -1081,8 +1089,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) allocate( hsrc(nz_data) ) do c=1,CS%num_col_u - ! c is an index for the next 3 lines but a multiplier for the rest of the loop - ! Therefore we use c as per C code and increment the index where necessary. + ! Set i and j to the structured indices of column c. i = CS%col_i_u(c) ; j = CS%col_j_u(c) if (mask_u(i,j,1) == 1.0) then do k=1,nz_data @@ -1102,7 +1109,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) else ! This next block should only ever be reached over land endif hsrc(k) = zTopOfCell - zBottomOfCell - if (hsrc(k)>0.) nPoints = nPoints + 1 + if (hsrc(k) > 0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model @@ -1129,8 +1136,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) !call pass_var(mask_z,G%Domain) allocate( hsrc(nz_data) ) do c=1,CS%num_col_v - ! c is an index for the next 3 lines but a multiplier for the rest of the loop - ! Therefore we use c as per C code and increment the index where necessary. + ! Set i and j to the structured indices of column c. i = CS%col_i_v(c) ; j = CS%col_j_v(c) if (mask_v(i,j,1) == 1.0) then do k=1,nz_data @@ -1150,7 +1156,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) else ! This next block should only ever be reached over land endif hsrc(k) = zTopOfCell - zBottomOfCell - if (hsrc(k)>0.) nPoints = nPoints + 1 + if (hsrc(k) > 0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model From d7d1351b4e9d90d19a13297a8e810f81cd7b3635 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 6 Jan 2023 13:42:31 -0500 Subject: [PATCH 117/213] Standardize the output of tiny real values Added code to harmonize differences in how different compilers format the output of tiny (< 1e-99) or huge (>= 1e100) real values. All answers are bitwise identical, but output could change with the PGI compiler for any cases that are writing out such extreme values. --- src/framework/MOM_document.F90 | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index a68a725feb..f32573815f 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -637,19 +637,33 @@ function real_string(val) elseif (val == 0.) then real_string = "0.0" else - if ((abs(val) <= 1.0e-100) .or. (abs(val) >= 1.0e100)) then - write(real_string(1:32), '(ES24.14E3)') val - if (.not.testFormattedFloatIsReal(real_string,val)) & - write(real_string(1:32), '(ES24.15E3)') val + if ((abs(val) < 1.0e-99) .or. (abs(val) >= 1.0e100)) then + write(real_string(1:32), '(ES24.14E4)') val + if (scan(real_string, "eE") == 0) then ! Fix a bug with a missing E in PGI formatting + ind = scan(real_string, "-+", back=.true.) + if (ind > index(real_string, ".") ) & ! Avoid changing a leading sign. + real_string = real_string(1:ind-1)//"E"//real_string(ind:) + endif + if (.not.testFormattedFloatIsReal(real_string, val)) then + write(real_string(1:32), '(ES25.15E4)') val + if (scan(real_string, "eE") == 0) then ! Fix a bug with a missing E in PGI formatting + ind = scan(real_string, "-+", back=.true.) + if (ind > index(real_string, ".") ) & ! Avoid changing a leading sign. + real_string = real_string(1:ind-1)//"E"//real_string(ind:) + endif + endif + ! Remove a leading 0 from the exponent, if it is there. + ind = max(index(real_string, "E+0"), index(real_string, "E-0")) + if (ind > 0) real_string = real_string(1:ind+1)//real_string(ind+3:) else write(real_string(1:32), '(ES23.14)') val - if (.not.testFormattedFloatIsReal(real_string,val)) & + if (.not.testFormattedFloatIsReal(real_string, val)) & write(real_string(1:32), '(ES23.15)') val endif - do - ind = index(real_string,"0E") + do ! Remove extra trailing 0s before the exponent. + ind = index(real_string, "0E") if (ind == 0) exit - if (real_string(ind-1:ind-1) == ".") exit + if (real_string(ind-1:ind-1) == ".") exit ! Leave at least one digit after the decimal point. real_string = real_string(1:ind-1)//real_string(ind+1:) enddo endif From ca72fcc860b1812c803114eec5153fb05082ab97 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 23 Dec 2022 04:48:15 -0500 Subject: [PATCH 118/213] *+Use runtime params in adjustment_initialization This commit replaces previously hard-coded values for dRho_dS and the temperature range for the sloshing test case with values read in from the existing runtime parameters DRHO_DS and the previously unused parameter T_RANGE that was already being read in for this configuration. The default value for dRho_dS from the EOS code (0.8 kg m-3 ppt-1) does not match hard coded value here (1 kg m-3 ppt-1), but in the existing tests using adjustment_initialization DRHO_DS was being explicitly set to the hard-coded value here, so I have chosen to reuse the same parameter with the same default value as is used elsewhere even though it could change answers in cases that do not set DRHO_DS consistently with the previous hard coded parameter. In addition, the previous default value for T_RANGE read into this module (0 degC) did not match the hard-coded range that was being used (1 degC). In this case I have chosen to change the default value for T_RANGE in this module so that by default this will reproduce the previous answers. As a result, there will be changes in the MOM_parameter doc all files for cases (like adjustment2d) that use the adjustment_initialization routines. This commit will change answers in some cases, but in the existing adjustment2d test cases in the MOM6-examples test suite, the answers are bitwise identical without any changes to the existing input parameter files. --- src/user/adjustment_initialization.F90 | 28 ++++++++++++++------------ 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 92a7faf29e..a958ebdebb 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -4,15 +4,15 @@ module adjustment_initialization ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE -use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR -use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE +use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR +use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA implicit none ; private @@ -79,6 +79,9 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & default=1.0e-3, units='m', scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DS", dRho_dS, & + "The partial derivative of density with salinity with a linear equation of state.", & + units="kg m-3 PSU-1", default=0.8, scale=US%kg_m3_to_R*US%S_to_ppt) ! Parameters specific to this experiment configuration call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & @@ -117,7 +120,6 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) - dRho_dS = 1.0*US%kg_m3_to_R*US%S_to_ppt if (delta_S_strat /= 0.) then ! This was previously coded ambiguously. adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth @@ -243,7 +245,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, call get_param(param_file, mdl, "S_RANGE", S_range, 'Initial salinity range', & default=2.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - default=0.0, units='C', scale=US%degC_to_C, do_not_log=just_read) + default=1.0, units='degC', scale=US%degC_to_C, do_not_log=just_read) ! Parameters specific to this experiment configuration BUT logged in previous s/r call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -292,7 +294,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, S(i,j,k) = S_ref + delta_S + 0.5 * ( eta1D(k)+eta1D(k+1) ) * dSdz x = abs(S(i,j,k) - 0.5*real(nz-1)/real(nz)*S_range)/S_range*real(2*nz) x = 1. - min(1., x) - T(i,j,k) = US%degC_to_C * x + T(i,j,k) = T_range * x enddo ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) @@ -303,7 +305,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, S(:,:,k) = S_ref + S_range * ( (real(k)-0.5) / real( nz ) ) ! x = abs(S(1,1,k) - 0.5*real(nz-1)/real(nz)*S_range)/S_range*real(2*nz) ! x = 1.-min(1., x) - ! T(:,:,k) = x + ! T(:,:,k) = T_range * x enddo case default From b3633f5932d135e8e1cfe815376a70997ca6c0ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 Jan 2023 07:27:47 -0500 Subject: [PATCH 119/213] Remove La_SL from wave_parameters_CS Removed the unused element La_SL from the wave_parameters_CS. Also added or renamed a few internal variables or amended the comments describing them to clarify what the code is doing. All answers are bitwise identical. --- src/user/MOM_wave_interface.F90 | 129 +++++++++++++++----------------- 1 file changed, 61 insertions(+), 68 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 70c0b4c71f..f0cbfd4e10 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -107,24 +107,24 @@ module MOM_wave_interface !! 2 - DHH85 !! 3 - LF17 !! -99 - No waves computed, but empirical Langmuir number used. - logical :: LagrangianMixing !< This feature is in development and not ready - !! True if Stokes drift is present and mixing - !! should be applied to Lagrangian current - !! (mean current + Stokes drift). - !! See Reichl et al., 2016 KPP-LT approach - logical :: StokesMixing !< This feature is in development and not ready. - !! True if vertical mixing of momentum - !! should be applied directly to Stokes current - !! (with separate mixing parameter for Eulerian - !! mixing contribution). - !! See Harcourt 2013, 2015 Second-Moment approach - logical :: CoriolisStokes !< This feature is in development and not ready. - ! True if Coriolis-Stokes acceleration should be applied. - integer :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points - !! or layer averaged. Set to 0 if mid-point and set to - !! 1 if average value of Stokes drift over level. - !! If advecting with Stokes transport, 1 is the correct - !! approach. + logical :: LagrangianMixing !< This feature is in development and not ready + !! True if Stokes drift is present and mixing + !! should be applied to Lagrangian current + !! (mean current + Stokes drift). + !! See Reichl et al., 2016 KPP-LT approach + logical :: StokesMixing !< This feature is in development and not ready. + !! True if vertical mixing of momentum + !! should be applied directly to Stokes current + !! (with separate mixing parameter for Eulerian + !! mixing contribution). + !! See Harcourt 2013, 2015 Second-Moment approach + logical :: CoriolisStokes !< This feature is in development and not ready. + ! True if Coriolis-Stokes acceleration should be applied. + integer :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points + !! or layer averaged. Set to 0 if mid-point and set to + !! 1 if average value of Stokes drift over level. + !! If advecting with Stokes transport, 1 is the correct + !! approach. ! Options if WaveMethod is Surface Stokes Drift Bands (1) integer :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers @@ -159,10 +159,7 @@ module MOM_wave_interface PrescribedSurfStkX !< Surface Stokes drift if prescribed [L T-1 ~> m s-1] real, allocatable, dimension(:) :: & PrescribedSurfStkY !< Surface Stokes drift if prescribed [L T-1 ~> m s-1] - !### It appears that La_SL is never used. Can it be removed? real, allocatable, dimension(:,:) :: & - La_SL, & !< SL Langmuir number (directionality factored later) [nondim] - !! Horizontal -> H points La_Turb !< Aligned Turbulent Langmuir number [nondim] !! Horizontal -> H points real, allocatable, dimension(:,:) :: & @@ -180,12 +177,11 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber - !> An arbitrary lower-bound on the Langmuir number [nondim]. Run-time parameter. - !! Langmuir number is sqrt(u_star/u_stokes). When both are small - !! but u_star is orders of magnitude smaller the Langmuir number could - !! have unintended consequences. Since both are small it can be safely capped - !! to avoid such consequences. - real :: La_min = 0.05 + real :: La_min = 0.05 !< An arbitrary lower-bound on the Langmuir number [nondim]. + !! Langmuir number is sqrt(u_star/u_stokes). When both are small + !! but u_star is orders of magnitude smaller, the Langmuir number could + !! have unintended consequences. Since both are small it can be safely + !! capped to avoid such consequences. ! Parameters used in estimating the wind speed or wave properties from the friction velocity real :: VonKar = -1.0 !< The von Karman coefficient as used in the MOM_wave_interface module [nondim] @@ -274,7 +270,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "If true, enables surface wave modules.", default=.false.) ! Check if using LA_LI2016 - call get_param(param_file,mdl,"USE_LA_LI2016",StatisticalWaves, & + call get_param(param_file, mdl, "USE_LA_LI2016", StatisticalWaves, & do_not_log=.true.,default=.false.) if (.not.(use_waves .or. StatisticalWaves)) return @@ -491,7 +487,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) ! c. Langmuir number - allocate(CS%La_SL(G%isc:G%iec,G%jsc:G%jec), source=0.0) allocate(CS%La_turb(G%isc:G%iec,G%jsc:G%jec), source=0.0) ! d. Viscosity for Stokes drift if (CS%StokesMixing) then @@ -676,13 +671,12 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) real :: PI ! 3.1415926535... [nondim] real :: La ! The local Langmuir number [nondim] integer :: ii, jj, kk, b, iim1, jjm1 - real :: idt ! 1 divided by the time step [T-1 ~> s-1] + real :: I_dt ! The inverse of the time step [T-1 ~> s-1] if (CS%WaveMethod==EFACTOR) return ! The following thickness cut-off would not be needed with the refactoring marked with '###' below. min_level_thick_avg = 1.e-3*US%m_to_Z - idt = 1.0/dt if (allocated(CS%US_x) .and. allocated(CS%US_y)) then call pass_vector(CS%US_x(:,:,:),CS%US_y(:,:,:), G%Domain) @@ -747,7 +741,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! -> Stokes drift in thin layers not averaged. if (level_thick>min_level_thick_avg) then do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then ! In wavenumber we are averaging over level CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) @@ -767,8 +761,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) endif CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC enddo - else - ! Take the value at the midpoint + else ! Take the value at the midpoint do b = 1,CS%NumBands if (CS%PartitionMode==0) then CMN_FAC = exp(MidPoint * 2. * CS%WaveNum_Cen(b)) @@ -781,6 +774,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) enddo enddo enddo + ! Computing Y direction Stokes drift do JJ = G%jscB,G%jecB do ii = G%isc,G%iec @@ -799,17 +793,17 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! -> Stokes drift in thin layers not averaged. if (level_thick>min_level_thick_avg) then do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then ! In wavenumber we are averaging over level CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) !### For accuracy and numerical stability rewrite this as: ! CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif (CS%PartitionMode==1) then - if (CS%StkLevelMode==0) then + elseif (CS%PartitionMode == 1) then + if (CS%StkLevelMode == 0) then ! Take the value at the midpoint CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif (CS%StkLevelMode==1) then + elseif (CS%StkLevelMode == 1) then ! Use a numerical integration and then divide by layer thickness WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) @@ -819,8 +813,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) endif CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC enddo - else - ! Take the value at the midpoint + else ! Take the value at the midpoint do b = 1,CS%NumBands if (CS%PartitionMode==0) then CMN_FAC = exp(MidPoint*2.*CS%WaveNum_Cen(b)) @@ -910,8 +903,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! Finding tendency of Stokes drift over the time step to apply ! as an acceleration to the models current. if ( dynamics_step .and. CS%Stokes_DDT ) then - CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%US_x_prev(:,:,:)) * idt - CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%US_y_prev(:,:,:)) * idt + I_dt = 1.0 / dt + CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%US_x_prev(:,:,:)) * I_dt + CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%US_y_prev(:,:,:)) * I_dt CS%US_x_prev(:,:,:) = CS%US_x(:,:,:) CS%US_y_prev(:,:,:) = CS%US_y(:,:,:) endif @@ -1159,17 +1153,14 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & call get_StokesSL_LiFoxKemper(ustar, hbl*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA) elseif (Waves%WaveMethod==Null_WaveMethod) then call MOM_error(FATAL, "Get_Langmuir_number called without defining a WaveMethod. "//& - "Suggest to make sure USE_LT is set/overridden to False or "//& - "choose a wave method (or set USE_LA_LI2016 to use statistical "//& - "waves.") + "Suggest to make sure USE_LT is set/overridden to False or choose "//& + "a wave method (or set USE_LA_LI2016 to use statistical waves).") endif if (.not.(Waves%WaveMethod==LF17)) then - ! This is an arbitrary lower bound on Langmuir number. - ! We shouldn't expect values lower than this, but - ! there is also no good reason to cap it here other then - ! to prevent large enhancements in unconstrained parts of - ! the curve fit parameterizations. + ! This expression uses an arbitrary lower bound on Langmuir number. + ! We shouldn't expect values lower than this, but there is also no good reason to cap it here + ! other than to prevent large enhancements in unconstrained parts of the curve fit parameterizations. ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) endif @@ -1282,21 +1273,21 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! the general peak wavenumber for Phillips' spectrum ! (Breivik et al., 2016) with correction of directional spreading kphil = 0.176 * UStokes / vstokes - ! - ! surface layer averaged Stokes drift with Stokes drift profile - ! estimated from Phillips' spectrum (Breivik et al., 2016) - ! the directional spreading effect from Webb and Fox-Kemper, 2015 - ! is also included - kstar = kphil * 2.56 + + ! Combining all of the expressions above gives kPhil as the following + ! where the first two lines are just a constant: + ! kphil = ((0.176 * us_to_u10 * u19p5_to_u10) / & + ! (0.5*0.125 * r_loss * fm_into_fp * 0.877 * CS%SWH_from_u10sq**2)) / & + ! (GV%g_Earth * u10**2) + ! surface layer z0 = abs(hbl) z0i = 1.0 / z0 - ! Combining all of the expressions above gives kPhil as the following - ! where the first two lines are just a constant: - ! kPhil = ((0.176 * us_to_u10 * u19p5_to_u10) / & - ! (0.5*0.125 * r_loss * fm_into_fp * 0.877 * 0.0246**2)) * & - ! (US%T_to_s*US%m_s_to_L_T)**2 / (CS%g_Earth * u10**2) + ! Surface layer averaged Stokes drift with Stokes drift profile + ! estimated from Phillips' spectrum (Breivik et al., 2016) + ! The directional spreading effect from Webb and Fox-Kemper, 2015 is also included. + kstar = kphil * 2.56 ! Terms 1 to 4, as written in the appendix of Li et al. (2017) r1 = ( 0.151 / kphil * z0i - 0.84 ) * & @@ -1861,9 +1852,11 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) ! Local variables real :: z0sm, z0, z0rough ! Roughness lengths [Z ~> m] + real :: ten_m_scale ! The 10 m reference height, in rescaled units [Z ~> m] real :: u10a ! The previous guess for u10 [L T-1 ~> m s-1] - real :: alpha ! A nondimensional factor in a parameterization [nondim] - real :: CD ! The drag coefficient [nondim] + real :: alpha ! The Charnock coeffient relating the wind friction velocity squared to the + ! roughness length [nondim] + real :: Cd2 ! The square of the drag coefficient [nondim] integer :: CT ! Uses empirical formula for z0 to convert ustar_air to u10 based on the @@ -1876,10 +1869,11 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) "ust_2_u10_coare3p5 called with a negative value of Waves%vonKar") z0sm = 0.11 * CS%nu_air / USTair ! Compute z0smooth from ustar guess - u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 - !### For efficiency change the line above to USTair * sqrt(1000.0) or USTair * 31.6227766 . u10a = 1000.0*US%m_s_to_L_T ! An insanely large upper bound for u10. + u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 + !### For efficiency change the line above to USTair * sqrt(1000.0) or USTair * 31.6227766 . + ten_m_scale = 10.0*US%m_to_Z CT=0 do while (abs(u10a/u10 - 1.) > 0.001) !### Change this to (abs(u10a - u10) > 0.001*u10) for efficiency. CT=CT+1 @@ -1887,8 +1881,8 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) alpha = min(0.028, 0.0017*US%L_T_to_m_s * u10 - 0.005) z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough - CD = ( CS%vonKar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness - u10 = US%Z_to_L*USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop + Cd2 = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute CD from derived roughness + u10 = US%Z_to_L*USTair/sqrt(Cd2) ! Compute new u10 from derived CD, while loop ! ends and checks for convergence...CT counter ! makes sure loop doesn't run away if function ! doesn't converge. This code was produced offline @@ -1911,7 +1905,6 @@ subroutine Waves_end(CS) if (allocated(CS%Freq_Cen)) deallocate( CS%Freq_Cen ) if (allocated(CS%Us_x)) deallocate( CS%Us_x ) if (allocated(CS%Us_y)) deallocate( CS%Us_y ) - if (allocated(CS%La_SL)) deallocate( CS%La_SL ) if (allocated(CS%La_turb)) deallocate( CS%La_turb ) if (allocated(CS%STKx0)) deallocate( CS%STKx0 ) if (allocated(CS%STKy0)) deallocate( CS%STKy0 ) From 8201db4c9d2743d80b0149b17628d0223e0dd4c5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 Jan 2023 07:46:04 -0500 Subject: [PATCH 120/213] +Add 3 Charnock coefficient runtime parameters Add 3 runtime parameters (CHARNOCK_MIN, CHARNOCK_SLOPE_U10 and CHARNOCK_0_WIND_INTERCEPT) to specify the curve fit in the Charnock coefficient calculation. By default all answers are bitwise identical, but there are 3 new runtime parameters in some MOM_parameter_doc.all files. --- src/user/MOM_wave_interface.F90 | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f0cbfd4e10..f55308358c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -189,6 +189,16 @@ module MOM_wave_interface real :: nu_air !< The viscosity of air, as used in wave calculations [Z2 T-1 ~> m2 s-1] real :: SWH_from_u10sq !< A factor for converting the square of the 10 m wind speed to the !! significant wave height [Z T2 L-2 ~> s m-2] + real :: Charnock_min !< The minimum value of the Charnock coefficient, which relates the square of + !! the air friction velocity divided by the gravitational acceleration to the + !! wave roughness length [nondim] + real :: Charnock_slope_U10 !< The partial derivative of the Charnock coefficient with the 10 m wind + !! speed [T L-1 ~> s m-1]. Note that in eq. 13 of the Edson et al. 2013 describing + !! the COARE 3.5 bulk flux algorithm, this slope is given as 0.017. However, 0.0017 + !! reproduces the curve in their figure 6, so that is the default value used in MOM6. + real :: Charnock_intercept !< The intercept of the fit for the Charnock coefficient in the limit of + !! no wind [nondim]. Note that this can be negative because CHARNOCK_MIN will keep + !! the final value for the Charnock coefficient from being from being negative. ! Options used with the test profile real :: TP_STKX0 !< Test profile x-stokes drift amplitude [L T-1 ~> m s-1] @@ -550,6 +560,21 @@ subroutine set_LF17_wave_params(param_file, mdl, US, CS) "A factor relating the square of the 10 m wind speed to the significant "//& "wave height, with a default value based on the Pierson-Moskowitz spectrum.", & units="s m-2", default=0.0246, scale=US%m_to_Z*US%L_T_to_m_s**2) + call get_param(param_file, mdl, "CHARNOCK_MIN", CS%Charnock_min, & + "The minimum value of the Charnock coefficient, which relates the square of "//& + "the air friction velocity divided by the gravitational acceleration to the "//& + "wave roughness length.", units="nondim", default=0.028) + call get_param(param_file, mdl, "CHARNOCK_SLOPE_U10", CS%Charnock_slope_U10, & + "The partial derivative of the Charnock coefficient with the 10 m wind speed. "//& + "Note that in eq. 13 of the Edson et al. 2013 describing the COARE 3.5 bulk "//& + "flux algorithm, this slope is given as 0.017. However, 0.0017 reproduces "//& + "the curve in their figure 6, so that is the default value used in MOM6.", & + units="s m-1", default=0.0017, scale=US%L_T_to_m_s) + call get_param(param_file, mdl, "CHARNOCK_0_WIND_INTERCEPT", CS%Charnock_intercept, & + "The intercept of the fit for the Charnock coefficient in the limit of no wind. "//& + "Note that this can be negative because CHARNOCK_MIN will keep the final "//& + "value for the Charnock coefficient from being from being negative.", & + units="nondim", default=-0.005) end subroutine set_LF17_wave_params @@ -1878,7 +1903,7 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) do while (abs(u10a/u10 - 1.) > 0.001) !### Change this to (abs(u10a - u10) > 0.001*u10) for efficiency. CT=CT+1 u10a = u10 - alpha = min(0.028, 0.0017*US%L_T_to_m_s * u10 - 0.005) + alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough Cd2 = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute CD from derived roughness From cfc2ed99c1eaf0f281a90a16caccc9889f388237 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 Jan 2023 08:15:18 -0500 Subject: [PATCH 121/213] +Add LANGMUIR_STOKES_BACKGROUND runtime parameter Added three new runtime parameters (LANGMUIR_STOKES_BACKGROUND, SURFBAND_MIN_THICK_AVG and SURFBAND_OVERRIDE_LAND_SPEED) to replace previously hard-coded dimensional parameter in the Langmuir number and Stokes drift calculations. By default all answers are bitwise identical, but there are new runtime parameters in some MOM_parameter_doc.all files. --- src/user/MOM_wave_interface.F90 | 36 ++++++++++++++++++++++++--------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f55308358c..cfa409068d 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -125,6 +125,9 @@ module MOM_wave_interface !! 1 if average value of Stokes drift over level. !! If advecting with Stokes transport, 1 is the correct !! approach. + real :: Stokes_min_thick_avg !< A layer thickness below which the cell-center Stokes drift is + !! used instead of the cell average [Z ~> m]. This is only used if + !! WAVE_INTERFACE_ANSWER_DATE < 20230101. ! Options if WaveMethod is Surface Stokes Drift Bands (1) integer :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers @@ -137,6 +140,9 @@ module MOM_wave_interface ! Options if using FMS DataOverride Routine character(len=40) :: SurfBandFileName !< Filename if using DataOverride + real :: land_speed !< A large Stokes velocity that can be used to indicate land values in + !! a data override file [L T-1 ~> m s-1]. Stokes drift components larger + !! than this are set to zero in data override calls for the Stokes drift. logical :: DataOver_initialized !< Flag for DataOverride Initialization ! Options for computing Langmuir number @@ -177,11 +183,13 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber - real :: La_min = 0.05 !< An arbitrary lower-bound on the Langmuir number [nondim]. + real :: La_min !< An arbitrary lower-bound on the Langmuir number [nondim]. !! Langmuir number is sqrt(u_star/u_stokes). When both are small !! but u_star is orders of magnitude smaller, the Langmuir number could !! have unintended consequences. Since both are small it can be safely !! capped to avoid such consequences. + real :: La_Stk_backgnd !< A small background Stokes velocity used in the denominator of + !! some expressions for the Langmuir number [L T-1 ~> m s-1] ! Parameters used in estimating the wind speed or wave properties from the friction velocity real :: VonKar = -1.0 !< The von Karman coefficient as used in the MOM_wave_interface module [nondim] @@ -390,6 +398,10 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar units='m', default=50.0, scale=US%m_to_Z) case (SURFBANDS_STRING)! Surface Stokes Drift Bands CS%WaveMethod = SURFBANDS + call get_param(param_file, mdl, "SURFBAND_MIN_THICK_AVG", CS%Stokes_min_thick_avg, & + "A layer thickness below which the cell-center Stokes drift is used instead of "//& + "the cell average. This is only used if WAVE_INTERFACE_ANSWER_DATE < 20230101.", & + units="m", default=0.1, scale=US%m_to_Z) !, do_not_log=(CS%answer_date>=20230101)) call get_param(param_file, mdl, "SURFBAND_SOURCE", TMPSTRING2, & "Choice of SURFACE_BANDS data mode, valid options include: \n"//& " DATAOVERRIDE - Read from NetCDF using FMS DataOverride. \n"//& @@ -403,6 +415,11 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%DataSource = DATAOVR call get_param(param_file, mdl, "SURFBAND_FILENAME", CS%SurfBandFileName, & "Filename of surface Stokes drift input band data.", default="StkSpec.nc") + call get_param(param_file, mdl, "SURFBAND_OVERRIDE_LAND_SPEED", CS%land_speed, & + "A large Stokes velocity that can be used to indicate land values in "//& + "a data override file. Stokes drift components larger than this are "//& + "set to zero in data override calls for the Stokes drift.", & + units="m s-1", default=10.0, scale=US%m_s_to_L_T) case (COUPLER_STRING)! Reserved for coupling CS%DataSource = COUPLER ! This is just to make something work, but it needs to be read from the wavemodel. @@ -480,6 +497,10 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "but is likely only encountered when the wind is very small and "//& "therefore its effects should be mostly benign.", & units="nondim", default=0.05) + call get_param(param_file, mdl, "LANGMUIR_STOKES_BACKGROUND", CS%La_Stk_backgnd, & + "A small background Stokes velocity used in the denominator of some "//& + "expressions for the Langmuir number.", & + units="m s-1", default=1.0e-10, scale=US%m_s_to_L_T, do_not_log=(CS%WaveMethod==LF17)) ! Allocate and initialize ! a. Stokes driftProfiles @@ -688,7 +709,6 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! Local Variables real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m] real :: level_thick ! The thickness of each layer [Z ~> m] - real :: min_level_thick_avg ! A minimum layer thickness for inclusion in the average [Z ~> m] real :: DecayScale ! A vertical decay scale in the test profile [Z ~> m] real :: CMN_FAC ! A nondimensional factor [nondim] real :: WN ! Model wavenumber [Z-1 ~> m-1] @@ -700,9 +720,6 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) if (CS%WaveMethod==EFACTOR) return - ! The following thickness cut-off would not be needed with the refactoring marked with '###' below. - min_level_thick_avg = 1.e-3*US%m_to_Z - if (allocated(CS%US_x) .and. allocated(CS%US_y)) then call pass_vector(CS%US_x(:,:,:),CS%US_y(:,:,:), G%Domain) endif @@ -764,7 +781,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick ! -> Stokes drift in thin layers not averaged. - if (level_thick>min_level_thick_avg) then + if (level_thick > CS%Stokes_min_thick_avg) then do b = 1,CS%NumBands if (CS%PartitionMode == 0) then ! In wavenumber we are averaging over level @@ -816,7 +833,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick ! -> Stokes drift in thin layers not averaged. - if (level_thick>min_level_thick_avg) then + if (level_thick > CS%Stokes_min_thick_avg) then do b = 1,CS%NumBands if (CS%PartitionMode == 0) then ! In wavenumber we are averaging over level @@ -1060,7 +1077,7 @@ subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS) ! Filter land values do j = G%jsd,G%jed do i = G%Isd,G%Ied - if ((abs(temp_x(i,j)) > 10.0*US%m_s_to_L_T) .or. (abs(temp_y(i,j)) > 10.0*US%m_s_to_L_T)) then + if ((abs(temp_x(i,j)) > CS%land_speed) .or. (abs(temp_y(i,j)) > CS%land_speed)) then ! Assume land-mask and zero out temp_x(i,j) = 0.0 temp_y(i,j) = 0.0 @@ -1186,8 +1203,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & ! This expression uses an arbitrary lower bound on Langmuir number. ! We shouldn't expect values lower than this, but there is also no good reason to cap it here ! other than to prevent large enhancements in unconstrained parts of the curve fit parameterizations. - ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. - LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) + LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + Waves%La_Stk_backgnd))) endif if (Use_MA) then From 85fffee7d5dbb4874f48a033c34dc4c21ebf632c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 Jan 2023 09:06:39 -0500 Subject: [PATCH 122/213] +Add WAVE_INTERFACE_ANSWER_DATE runtime parameter Added the new runtime parameter WAVE_INTERFACE_ANSWER_DATE, with a default value that is temporarily set to use the previous answers. This is used to select a more efficient option in ust_2_u10_coare3p5. The answers with this new option differ at roundoff, but are otherwise very similar. By default all answers are bitwise identical, but there is a new runtime parameters in some MOM_parameter_doc.all files. --- src/user/MOM_wave_interface.F90 | 86 ++++++++++++++++++++++++--------- 1 file changed, 64 insertions(+), 22 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index cfa409068d..8b95c54199 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -128,6 +128,11 @@ module MOM_wave_interface real :: Stokes_min_thick_avg !< A layer thickness below which the cell-center Stokes drift is !! used instead of the cell average [Z ~> m]. This is only used if !! WAVE_INTERFACE_ANSWER_DATE < 20230101. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the + !! surface wave calculations. Values below 20230101 recover the + !! answers from the end of 2022, while higher values use updated + !! and more robust forms of the same expressions. + ! Options if WaveMethod is Surface Stokes Drift Bands (1) integer :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers @@ -156,6 +161,8 @@ module MOM_wave_interface real :: g_Earth !< The gravitational acceleration, equivalent to GV%g_Earth but with !! different dimensional rescaling appropriate for deep-water gravity !! waves [Z T-2 ~> m s-2] + real :: I_g_Earth !< The inversse of the gravitational acceleration, with dimensional rescaling + !! appropriate for deep-water gravity waves [T2 Z-1 ~> s2 m-1] ! Surface Wave Dependent 1d/2d/3d vars real, allocatable, dimension(:) :: & WaveNum_Cen !< Wavenumber bands for read/coupled [Z-1 ~> m-1] @@ -275,6 +282,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar character*(12), parameter :: DATAOVR_STRING = "DATAOVERRIDE" character*(7), parameter :: COUPLER_STRING = "COUPLER" character*(5), parameter :: INPUT_STRING = "INPUT" + integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags logical :: use_waves logical :: StatisticalWaves @@ -298,12 +306,23 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%Time => Time CS%g_Earth = US%L_to_Z**2*GV%g_Earth + CS%I_g_Earth = 1.0 / CS%g_Earth ! Add any initializations needed here CS%DataOver_initialized = .false. call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231) + + call get_param(param_file, mdl, "WAVE_INTERFACE_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the surface wave "//& + "calculations. Values below 20230101 recover the answers from the end of 2022, "//& + "while higher values use updated and more robust forms of the same expressions.", & + default=20221232) !### default=default_answer_date) + ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in "//& @@ -1894,10 +1913,13 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) ! Local variables real :: z0sm, z0, z0rough ! Roughness lengths [Z ~> m] real :: ten_m_scale ! The 10 m reference height, in rescaled units [Z ~> m] + real :: I_ten_m_scale ! The inverse of the 10 m reference height, in rescaled units [Z-1 ~> m-1] real :: u10a ! The previous guess for u10 [L T-1 ~> m s-1] real :: alpha ! The Charnock coeffient relating the wind friction velocity squared to the ! roughness length [nondim] real :: Cd2 ! The square of the drag coefficient [nondim] + real :: I_Cd ! The inverse of the drag coefficient [nondim] + real :: I_vonKar ! The inverse of the von Karman coefficient [nondim] integer :: CT ! Uses empirical formula for z0 to convert ustar_air to u10 based on the @@ -1912,29 +1934,49 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) z0sm = 0.11 * CS%nu_air / USTair ! Compute z0smooth from ustar guess u10a = 1000.0*US%m_s_to_L_T ! An insanely large upper bound for u10. - u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 - !### For efficiency change the line above to USTair * sqrt(1000.0) or USTair * 31.6227766 . + if (CS%answer_date < 20230101) then + u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 ten_m_scale = 10.0*US%m_to_Z - CT=0 - do while (abs(u10a/u10 - 1.) > 0.001) !### Change this to (abs(u10a - u10) > 0.001*u10) for efficiency. - CT=CT+1 - u10a = u10 - alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) - z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess - z0 = z0sm + z0rough - Cd2 = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute CD from derived roughness - u10 = US%Z_to_L*USTair/sqrt(Cd2) ! Compute new u10 from derived CD, while loop - ! ends and checks for convergence...CT counter - ! makes sure loop doesn't run away if function - ! doesn't converge. This code was produced offline - ! and converged rapidly (e.g. 2 cycles) - ! for ustar=0.0001:0.0001:10. - if (CT>20) then - u10 = US%Z_to_L*USTair/sqrt(0.0015) ! I don't expect to get here, but just - ! in case it will output a reasonable value. - exit - endif - enddo + CT=0 + do while (abs(u10a/u10 - 1.) > 0.001) + CT=CT+1 + u10a = u10 + alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) + z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess + z0 = z0sm + z0rough + Cd2 = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute CD from derived roughness + u10 = US%Z_to_L*USTair/sqrt(Cd2) ! Compute new u10 from derived CD, while loop + ! ends and checks for convergence...CT counter + ! makes sure loop doesn't run away if function + ! doesn't converge. This code was produced offline + ! and converged rapidly (e.g. 2 cycles) + ! for ustar=0.0001:0.0001:10. + if (CT>20) then + u10 = US%Z_to_L*USTair/sqrt(0.0015) ! I don't expect to get here, but just + ! in case it will output a reasonable value. + exit + endif + enddo + + else ! Use more efficient expressions that are mathematically equivalent to those above. + u10 = US%Z_to_L*USTair * sqrt(1000.0) ! Guess for u10. Is 1000 here the ratio of the densities of water and air? + I_vonKar = 1.0 / CS%vonKar + I_ten_m_scale = 0.1*US%Z_to_m + + do CT=1,20 + if (abs(u10a - u10) <= 0.001*u10) exit ! Check for convergence. + u10a = u10 + alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) + z0rough = alpha * (CS%I_g_Earth * USTair**2) ! Compute z0rough from ustar guess + z0 = z0sm + z0rough + I_Cd = abs(log(z0 * I_ten_m_scale)) * I_vonKar ! Compute CD from derived roughness + u10 = US%Z_to_L*USTair * I_Cd ! Compute new u10 from the derived CD. + enddo + + ! Output a reasonable estimate of u10 if the iteration has not converged. The hard-coded + ! number 25.82 is 1/sqrt(0.0015) to 4 decimal places, but the exact value should not matter. + if (abs(u10a - u10) > 0.001*u10) u10 = US%Z_to_L*USTair * 25.82 + endif end subroutine ust_2_u10_coare3p5 From 504769246b6a014b5184f5ef81dc95980b05509f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 Jan 2023 11:04:02 -0500 Subject: [PATCH 123/213] +Make get_StokesSL_LiFoxKemper more robust Modified get_StokesSL_LiFoxKemper to use more robust expressions when WAVE_INTERFACE_ANSWER_DATE >= 20230102, and reset the value to change the answers to ust_2_u10_coare3p5 when WAVE_INTERFACE_ANSWER_DATE >= 20230103. Both options have been tested independently, and give answers that are similar to but more robust than the previous expressions. By default all answers are bitwise identical, but there is a new use of the runtime parameter WAVE_INTERFACE_ANSWER_DATE. --- src/user/MOM_wave_interface.F90 | 89 ++++++++++++++++++--------------- 1 file changed, 48 insertions(+), 41 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 8b95c54199..ec92de329a 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -321,7 +321,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "The vintage of the order of arithmetic and expressions in the surface wave "//& "calculations. Values below 20230101 recover the answers from the end of 2022, "//& "while higher values use updated and more robust forms of the same expressions.", & - default=20221232) !### default=default_answer_date) + default=20221231) !### default=default_answer_date) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, & @@ -1298,9 +1298,9 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) real :: z0 ! The boundary layer depth [Z ~> m] real :: z0i ! The inverse of theboundary layer depth [Z-1 ~> m-1] real :: r1, r2, r3, r4 ! Nondimensional ratios [nondim] - ! real :: r5 ! A single expression that combines r3 and r4 [nondim] - ! real :: root_2kz ! The square root of twice the peak wavenumber times the - ! ! boundary layer depth [nondim] + real :: r5 ! A single expression that combines r2 and r4 [nondim] + real :: root_2kz ! The square root of twice the peak wavenumber times the + ! boundary layer depth [nondim] real :: u10 ! The 10 m wind speed [L T-1 ~> m s-1] real :: PI ! 3.1415926535... [nondim] @@ -1342,48 +1342,55 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! surface layer z0 = abs(hbl) - z0i = 1.0 / z0 + + if (CS%answer_date < 20230102) then + z0i = 1.0 / z0 ! Surface layer averaged Stokes drift with Stokes drift profile ! estimated from Phillips' spectrum (Breivik et al., 2016) ! The directional spreading effect from Webb and Fox-Kemper, 2015 is also included. kstar = kphil * 2.56 - ! Terms 1 to 4, as written in the appendix of Li et al. (2017) - r1 = ( 0.151 / kphil * z0i - 0.84 ) * & - ( 1.0 - exp(-2.0 * kphil * z0) ) - r2 = -( 0.84 + 0.0591 / kphil * z0i ) * & - sqrt( 2.0 * PI * kphil * z0 ) * & - erfc( sqrt( 2.0 * kphil * z0 ) ) - r3 = ( 0.0632 / kstar * z0i + 0.125 ) * & - (1.0 - exp(-2.0 * kstar * z0) ) - r4 = ( 0.125 + 0.0946 / kstar * z0i ) * & - sqrt( 2.0 * PI * kstar * z0) * & - erfc( sqrt( 2.0 * kstar * z0 ) ) - UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - - ! The following is equivalent to the code above, but avoids singularities -! r1 = ( 0.302 - 1.68*kphil*z0 ) * one_minus_exp_x(2.0*kphil * z0) -! r3 = ( 0.1264 + 0.64*kphil*z0 ) * one_minus_exp_x(5.12*kphil * z0) -! root_2kz = sqrt(2.0 * kphil * z0) -! ! r2 = -( 0.84 + 0.0591*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) -! ! r4 = ( 0.2 + 0.059125*2.0 / (root_2kz**2) ) * sqrt(PI)* root_2kz * erfc( 1.6 * root_2kz ) -! -! ! r5 = r2 + r4 (with a small correction to one coefficient to avoid a singularity when z0 = 0): -! ! The correction leads to <1% relative differences in (r2+r4) for root_2kz > 0.05, but without -! ! it the values of r2 + r4 are qualitatively wrong (>50% errors) for root_2kz < 0.0015 . -! ! It has been verified that these two expressions for r5 are the same to 6 decimal places for -! ! root_2kz between 1e-10 and 1e-3, but that the first one degrades for smaller values. -! if (root_2kz > 1e-3) then -! r5 = sqrt(PI) * (root_2kz * (-0.84 * erfc(root_2kz) + 0.2 * erfc(1.6*root_2kz)) + & -! 0.1182 * (erfc(1.6*root_2kz) - erfc(root_2kz)) / root_2kz) -! else -! ! It is more accurate to replace erf with the first two terms of its Taylor series -! ! erf(z) = (2/sqrt(pi)) * z * (1. - (1/3)*z**2 + (1/10)*z**4 - (1/42)*z**6 + ...) -! ! and then cancel or combine common terms and drop negligibly small terms. -! r5 = -0.64*sqrt(PI)*root_2kz + (-0.14184 + 1.0839648 * root_2kz**2) -! endif -! UStokes_sl = UStokes * (0.715 + ((r1 + r2) + r5)) + ! Terms 1 to 4, as written in the appendix of Li et al. (2017) + r1 = ( 0.151 / kphil * z0i - 0.84 ) * & + ( 1.0 - exp(-2.0 * kphil * z0) ) + r2 = -( 0.84 + 0.0591 / kphil * z0i ) * & + sqrt( 2.0 * PI * kphil * z0 ) * & + erfc( sqrt( 2.0 * kphil * z0 ) ) + r3 = ( 0.0632 / kstar * z0i + 0.125 ) * & + (1.0 - exp(-2.0 * kstar * z0) ) + r4 = ( 0.125 + 0.0946 / kstar * z0i ) * & + sqrt( 2.0 * PI * kstar * z0) * & + erfc( sqrt( 2.0 * kstar * z0 ) ) + UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) + else + ! The following is equivalent to the code above, but avoids singularities + r1 = ( 0.302 - 1.68*(kphil*z0) ) * one_minus_exp_x(2.0 * (kphil * z0)) + r3 = ( 0.1264 + 0.64*(kphil*z0) ) * one_minus_exp_x(5.12 * (kphil * z0)) + + root_2kz = sqrt(2.0 * kphil * z0) + ! r2 = -( 0.84 + 0.0591 / (kphil * z0) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) + ! r4 = ( 0.2 + 0.059125 / (kphil * z0) ) * sqrt(PI) * root_2kz * erfc( 1.6 * root_2kz ) + + ! r2 = -( 0.84 + 0.0591*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) + ! r4 = ( 0.2 + 0.059125*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( 1.6 * root_2kz ) + + ! r5 = r2 + r4 (with a small correction to one coefficient to avoid a singularity when z0 = 0): + ! The correction leads to <1% relative differences in (r2+r4) for root_2kz > 0.05, but without + ! it the values of r2 + r4 are qualitatively wrong (>50% errors) for root_2kz < 0.0015 . + ! It has been verified that these two expressions for r5 are the same to 6 decimal places for + ! root_2kz between 1e-10 and 1e-3, but that the first one degrades for smaller values. + if (root_2kz > 1e-3) then + r5 = sqrt(PI) * (root_2kz * (-0.84 * erfc(root_2kz) + 0.2 * erfc(1.6*root_2kz)) + & + 0.1182 * (erfc(1.6*root_2kz) - erfc(root_2kz)) / root_2kz) + else + ! It is more accurate to replace erf with the first two terms of its Taylor series + ! erf(z) = (2/sqrt(pi)) * z * (1. - (1/3)*z**2 + (1/10)*z**4 - (1/42)*z**6 + ...) + ! and then cancel or combine common terms and drop negligibly small terms. + r5 = -0.64*sqrt(PI)*root_2kz + (-0.14184 + 1.0839648 * root_2kz**2) + endif + UStokes_sl = UStokes * (0.715 + ((r1 + r3) + r5)) + endif if (UStokes_sl /= 0.0) LA = sqrt(US%Z_to_L*ustar / UStokes_sl) endif @@ -1934,7 +1941,7 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) z0sm = 0.11 * CS%nu_air / USTair ! Compute z0smooth from ustar guess u10a = 1000.0*US%m_s_to_L_T ! An insanely large upper bound for u10. - if (CS%answer_date < 20230101) then + if (CS%answer_date < 20230103) then u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 ten_m_scale = 10.0*US%m_to_Z CT=0 From 60961661f29a3a4d42bf3d0525fdec36cfc5b90b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 Jan 2023 11:33:50 -0500 Subject: [PATCH 124/213] +Make Update_Stokes_Drift more robust Modified Update_Stokes_Drift to use more robust expressions when WAVE_INTERFACE_ANSWER_DATE >= 20230101. This new option may not be as fully tested as it should be, but it appears to give answers that are similar to but more robust than the previous expressions. By default all answers are bitwise identical, but there is a new use of the runtime parameter WAVE_INTERFACE_ANSWER_DATE. --- src/user/MOM_wave_interface.F90 | 96 ++++++++++++++++++++------------- 1 file changed, 58 insertions(+), 38 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ec92de329a..745d529c1d 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -420,7 +420,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar call get_param(param_file, mdl, "SURFBAND_MIN_THICK_AVG", CS%Stokes_min_thick_avg, & "A layer thickness below which the cell-center Stokes drift is used instead of "//& "the cell average. This is only used if WAVE_INTERFACE_ANSWER_DATE < 20230101.", & - units="m", default=0.1, scale=US%m_to_Z) !, do_not_log=(CS%answer_date>=20230101)) + units="m", default=0.1, scale=US%m_to_Z, do_not_log=(CS%answer_date>=20230101)) call get_param(param_file, mdl, "SURFBAND_SOURCE", TMPSTRING2, & "Choice of SURFACE_BANDS data mode, valid options include: \n"//& " DATAOVERRIDE - Read from NetCDF using FMS DataOverride. \n"//& @@ -433,7 +433,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar case (DATAOVR_STRING)! Using Data Override CS%DataSource = DATAOVR call get_param(param_file, mdl, "SURFBAND_FILENAME", CS%SurfBandFileName, & - "Filename of surface Stokes drift input band data.", default="StkSpec.nc") + "Filename of surface Stokes drift input band data.", default="StkSpec.nc") call get_param(param_file, mdl, "SURFBAND_OVERRIDE_LAND_SPEED", CS%land_speed, & "A large Stokes velocity that can be used to indicate land values in "//& "a data override file. Stokes drift components larger than this are "//& @@ -799,26 +799,38 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) level_thick = 0.5*GV%H_to_Z*(h(II,jj,kk)+h(IIm1,jj,kk)) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick - ! -> Stokes drift in thin layers not averaged. - if (level_thick > CS%Stokes_min_thick_avg) then + + if (CS%answer_date >= 20230101) then + ! Use more accurate and numerically stable expressions that work even for vanished layers. + do b = 1,CS%NumBands + if (CS%PartitionMode == 0) then + ! Average over a layer using the bin's central wavenumber. + CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==0)) then + ! Take the value at the midpoint + CMN_FAC = exp(MidPoint * 2. * (CS%Freq_Cen(b)**2 * CS%I_g_Earth)) + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==1)) then + ! Use an analytic expression for the average of an exponential over a layer + WN = CS%Freq_Cen(b)**2 * CS%I_g_Earth + CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) + endif + CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC + enddo + + elseif (level_thick > CS%Stokes_min_thick_avg) then + ! -> Stokes drift in thin layers not averaged. do b = 1,CS%NumBands if (CS%PartitionMode == 0) then ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b))) & / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif (CS%PartitionMode==1) then - if (CS%StkLevelMode==0) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif (CS%StkLevelMode==1) then - ! Use a numerical integration and then divide by layer thickness - WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g - CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) - endif + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode == 0)) then + ! Take the value at the midpoint + CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==1)) then + ! Use a numerical integration and then divide by layer thickness + WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g + CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC enddo @@ -851,26 +863,37 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) level_thick = 0.5*GV%H_to_Z*(h(ii,JJ,kk)+h(ii,JJm1,kk)) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick - ! -> Stokes drift in thin layers not averaged. - if (level_thick > CS%Stokes_min_thick_avg) then + + if (CS%answer_date >= 20230101) then + ! Use more accurate and numerically stable expressions that work even for vanished layers. do b = 1,CS%NumBands if (CS%PartitionMode == 0) then - ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& + ! Average over a layer using the bin's central wavenumber. + CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==0)) then + ! Take the value at the midpoint + CMN_FAC = exp(MidPoint * 2. * (CS%Freq_Cen(b)**2 * CS%I_g_Earth)) + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==1)) then + ! Use an analytic expression for the average of an exponential over a layer + WN = CS%Freq_Cen(b)**2 * CS%I_g_Earth + CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) + endif + CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC + enddo + elseif (level_thick > CS%Stokes_min_thick_avg) then + ! -> Stokes drift in thin layers not averaged. + do b = 1,CS%NumBands + if (CS%PartitionMode == 0) then + ! In wavenumber we are averaging over level + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b))) & / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif (CS%PartitionMode == 1) then - if (CS%StkLevelMode == 0) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif (CS%StkLevelMode == 1) then - ! Use a numerical integration and then divide by layer thickness - WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g - CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) - endif + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode == 0)) then + ! Take the value at the midpoint + CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) + elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode == 1)) then + ! Use a numerical integration and then divide by layer thickness + WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g + CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC enddo @@ -1369,9 +1392,6 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) r3 = ( 0.1264 + 0.64*(kphil*z0) ) * one_minus_exp_x(5.12 * (kphil * z0)) root_2kz = sqrt(2.0 * kphil * z0) - ! r2 = -( 0.84 + 0.0591 / (kphil * z0) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) - ! r4 = ( 0.2 + 0.059125 / (kphil * z0) ) * sqrt(PI) * root_2kz * erfc( 1.6 * root_2kz ) - ! r2 = -( 0.84 + 0.0591*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) ! r4 = ( 0.2 + 0.059125*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( 1.6 * root_2kz ) From 758c792e8c0a9450ad14ff6646c565ef51cef832 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 2 Jan 2023 06:17:59 -0500 Subject: [PATCH 125/213] +Eliminate wave_parameters_CS%StkLevelMode Eliminated the hard-coded wave_parameters_CS StkLevelMode element and associated code. Also modified the description of WAVE_INTERFACE_ANSWER_DATE to describe the meaning of its various settings. A handful of spelling errors were also corrected. All answers are bitwise identical, but there are changes to some MOM_parameter_doc files. --- src/user/MOM_wave_interface.F90 | 57 +++++++++++++-------------------- 1 file changed, 22 insertions(+), 35 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 745d529c1d..53cf2aea8c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -120,11 +120,6 @@ module MOM_wave_interface !! See Harcourt 2013, 2015 Second-Moment approach logical :: CoriolisStokes !< This feature is in development and not ready. ! True if Coriolis-Stokes acceleration should be applied. - integer :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points - !! or layer averaged. Set to 0 if mid-point and set to - !! 1 if average value of Stokes drift over level. - !! If advecting with Stokes transport, 1 is the correct - !! approach. real :: Stokes_min_thick_avg !< A layer thickness below which the cell-center Stokes drift is !! used instead of the cell average [Z ~> m]. This is only used if !! WAVE_INTERFACE_ANSWER_DATE < 20230101. @@ -161,7 +156,7 @@ module MOM_wave_interface real :: g_Earth !< The gravitational acceleration, equivalent to GV%g_Earth but with !! different dimensional rescaling appropriate for deep-water gravity !! waves [Z T-2 ~> m s-2] - real :: I_g_Earth !< The inversse of the gravitational acceleration, with dimensional rescaling + real :: I_g_Earth !< The inverse of the gravitational acceleration, with dimensional rescaling !! appropriate for deep-water gravity waves [T2 Z-1 ~> s2 m-1] ! Surface Wave Dependent 1d/2d/3d vars real, allocatable, dimension(:) :: & @@ -320,8 +315,12 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar call get_param(param_file, mdl, "WAVE_INTERFACE_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the surface wave "//& "calculations. Values below 20230101 recover the answers from the end of 2022, "//& - "while higher values use updated and more robust forms of the same expressions.", & - default=20221231) !### default=default_answer_date) + "while higher values use updated and more robust forms of the same expressions:\n"//& + "\t < 20230101 - Original answers for wave interface routines\n"//& + "\t >= 20230101 - More robust expressions for Update_Stokes_Drift\n"//& + "\t >= 20230102 - More robust expressions for get_StokesSL_LiFoxKemper\n"//& + "\t >= 20230103 - More robust expressions for ust_2_u10_coare3p5", & + default=20221231) ! In due course change the default to default=default_answer_date) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, & @@ -509,7 +508,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar ! Langmuir number Options (Note that CS%LA_FracHBL is set above.) call get_param(param_file, mdl, "LA_MISALIGNMENT", CS%LA_Misalignment, & - "Flag (logical) if using misalignment bt shear and waves in LA", & + "Flag (logical) if using misalignment between shear and waves in LA", & default=.false.) call get_param(param_file, mdl, "MIN_LANGMUIR", CS%La_min, & "A minimum value for all Langmuir numbers that is not physical, "//& @@ -806,10 +805,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) if (CS%PartitionMode == 0) then ! Average over a layer using the bin's central wavenumber. CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==0)) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * (CS%Freq_Cen(b)**2 * CS%I_g_Earth)) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==1)) then + else ! Use an analytic expression for the average of an exponential over a layer WN = CS%Freq_Cen(b)**2 * CS%I_g_Earth CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) @@ -824,10 +820,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! In wavenumber we are averaging over level CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b))) & / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode == 0)) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==1)) then + else ! Use a numerical integration and then divide by layer thickness WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) @@ -836,9 +829,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) enddo else ! Take the value at the midpoint do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then CMN_FAC = exp(MidPoint * 2. * CS%WaveNum_Cen(b)) - elseif (CS%PartitionMode==1) then + else CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) endif CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC @@ -870,10 +863,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) if (CS%PartitionMode == 0) then ! Average over a layer using the bin's central wavenumber. CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==0)) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * (CS%Freq_Cen(b)**2 * CS%I_g_Earth)) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode==1)) then + else ! Use an analytic expression for the average of an exponential over a layer WN = CS%Freq_Cen(b)**2 * CS%I_g_Earth CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) @@ -887,10 +877,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! In wavenumber we are averaging over level CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b))) & / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode == 0)) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif ((CS%PartitionMode == 1) .and. (CS%StkLevelMode == 1)) then + else ! Use a numerical integration and then divide by layer thickness WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) @@ -899,9 +886,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) enddo else ! Take the value at the midpoint do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then CMN_FAC = exp(MidPoint*2.*CS%WaveNum_Cen(b)) - elseif (CS%PartitionMode==1) then + else CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) endif CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC @@ -1041,7 +1028,7 @@ subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS) ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal Stokes drift of band at h-points [L T-1 ~> m s-1] - real :: temp_y(SZI_(G),SZJ_(G)) ! Psuedo-meridional Stokes drift of band at h-points [L T-1 ~> m s-1] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional Stokes drift of band at h-points [L T-1 ~> m s-1] integer, dimension(4) :: sizes ! The sizes of the various dimensions of the variable. character(len=48) :: dim_name(4) ! The names of the dimensions of the variable. character(len=20) :: varname ! The name of an input variable for data override. @@ -1288,7 +1275,7 @@ end function get_wave_method !! !! Update (Jan/25): !! - Converted from function to subroutine, now returns Langmuir number. -!! - Computs 10m wind internally, so only ustar and hbl need passed to +!! - Compute 10m wind internally, so only ustar and hbl need passed to !! subroutine. !! !! Qing Li, 160606 @@ -1319,7 +1306,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) real :: kstar ! A rescaled wavenumber? [Z-1 ~> m-1] real :: vstokes ! The total Stokes transport [Z L T-1 ~> m2 s-1] real :: z0 ! The boundary layer depth [Z ~> m] - real :: z0i ! The inverse of theboundary layer depth [Z-1 ~> m-1] + real :: z0i ! The inverse of the boundary layer depth [Z-1 ~> m-1] real :: r1, r2, r3, r4 ! Nondimensional ratios [nondim] real :: r5 ! A single expression that combines r2 and r4 [nondim] real :: root_2kz ! The square root of twice the peak wavenumber times the @@ -1730,7 +1717,7 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) if (CS%id_P_deltaStokes_L > 0) P_deltaStokes_L(:,:,:) = 0.0 ! First compute PGFu. The Stokes-induced pressure anomaly diagnostic is stored from this calculation. - ! > Seeking PGFx at (I,j), meanining we need to compute pressure at h-points (i,j) and (i+1,j). + ! > Seeking PGFx at (I,j), meaning we need to compute pressure at h-points (i,j) and (i+1,j). ! UL(i,j) -> found as average of I-1 & I on j ! UR(i+1,j) -> found as average of I & I+1 on j ! VL(i,j) -> found on i as average of J-1 & J @@ -1826,7 +1813,7 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) enddo ; enddo ! Next compute PGFv. The Stokes-induced pressure anomaly diagnostic is stored from this calculation. - ! > Seeking PGFy at (i,J), meanining we need to compute pressure at h-points (i,j) and (i,j+1). + ! > Seeking PGFy at (i,J), meaning we need to compute pressure at h-points (i,j) and (i,j+1). ! UL(i,j) -> found as average of I-1 & I on j ! UR(i,j+1) -> found as average of I-1 & I on j+1 ! VL(i,j) -> found on i as average of J-1 & J @@ -2084,7 +2071,7 @@ end subroutine waves_register_restarts !! interpret surface wave data for MOM6. In its original form, the !! capabilities include setting the Stokes drift in the model (from a !! variety of sources including prescribed, empirical, and input -!! files). In short order, the plan is to also ammend the subroutine +!! files). In short order, the plan is to also amend the subroutine !! to accept Stokes drift information from an external coupler. !! Eventually, it will be necessary to break this file apart so that !! general wave information may be stored in the control structure From 78c91cd8d440eaf108bb1223a02a18a7a985bdb0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 7 Jan 2023 07:06:40 -0500 Subject: [PATCH 126/213] +Renamed internal Cd variables Renamed two internal variables to Cd and I_sqrtCd in ust_2_u10_coare3p5 for greater clarity and corrected their descriptions in comments, following advice from the review of the pull request that this is a part of. Also added the missing units description "nondim" to the get_param call for DHH85_AGE. All answers are bitwise identical. --- src/user/MOM_wave_interface.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 53cf2aea8c..f99ca27994 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -485,7 +485,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "Choose true to use waveage in peak frequency.", default=.false.) call get_param(param_file, mdl, "DHH85_AGE", CS%WaveAge, & "Wave Age for DHH85 spectrum.", & - units='', default=1.2) + units='nondim', default=1.2) call get_param(param_file, mdl, "DHH85_WIND", CS%WaveWind, & "Wind speed for DHH85 spectrum.", & units='m s-1', default=10.0, scale=US%m_s_to_L_T) @@ -1931,8 +1931,8 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) real :: u10a ! The previous guess for u10 [L T-1 ~> m s-1] real :: alpha ! The Charnock coeffient relating the wind friction velocity squared to the ! roughness length [nondim] - real :: Cd2 ! The square of the drag coefficient [nondim] - real :: I_Cd ! The inverse of the drag coefficient [nondim] + real :: Cd ! The drag coefficient [nondim] + real :: I_sqrtCd ! The inverse of the square root of the drag coefficient [nondim] real :: I_vonKar ! The inverse of the von Karman coefficient [nondim] integer :: CT @@ -1958,8 +1958,8 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough - Cd2 = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute CD from derived roughness - u10 = US%Z_to_L*USTair/sqrt(Cd2) ! Compute new u10 from derived CD, while loop + Cd = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute Cd from derived roughness + u10 = US%Z_to_L*USTair/sqrt(Cd) ! Compute new u10 from derived Cd, while loop ! ends and checks for convergence...CT counter ! makes sure loop doesn't run away if function ! doesn't converge. This code was produced offline @@ -1973,7 +1973,8 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) enddo else ! Use more efficient expressions that are mathematically equivalent to those above. - u10 = US%Z_to_L*USTair * sqrt(1000.0) ! Guess for u10. Is 1000 here the ratio of the densities of water and air? + u10 = US%Z_to_L*USTair * sqrt(1000.0) ! First guess for u10. + ! In the line above 1000 is the inverse of a plausible first guess of the drag coefficient. I_vonKar = 1.0 / CS%vonKar I_ten_m_scale = 0.1*US%Z_to_m @@ -1983,8 +1984,8 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) z0rough = alpha * (CS%I_g_Earth * USTair**2) ! Compute z0rough from ustar guess z0 = z0sm + z0rough - I_Cd = abs(log(z0 * I_ten_m_scale)) * I_vonKar ! Compute CD from derived roughness - u10 = US%Z_to_L*USTair * I_Cd ! Compute new u10 from the derived CD. + I_sqrtCd = abs(log(z0 * I_ten_m_scale)) * I_vonKar ! Compute Cd from derived roughness + u10 = US%Z_to_L*USTair * I_sqrtCd ! Compute new u10 from the derived Cd. enddo ! Output a reasonable estimate of u10 if the iteration has not converged. The hard-coded From 3f57d75f39ea82f33270157e75618c8f671e9524 Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Mon, 9 Jan 2023 07:16:09 -0700 Subject: [PATCH 127/213] Add GL90 diagnostics (#293) * Add GL90 parameterization in stacked shallow water This adds a new vertical viscosity parameterization as in Greatbatch and Lamb (1990), Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, and is the equivalent of the Gent & McWilliams (1990) parameterization, but in a TWA (thickness-weighted averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM via thermal wind balance, and the following relation: nu = kappa_GM * f^2 / N^2. The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary conditions at the top and bottom. In the current implementation, kappa_GM is assumed either (a) constant or as (b) having an EBT structure. A third possible formulation of nu is depth-independent: nu = f^2 * alpha The latter formulation would be equivalent to a kappa_GM that varies as N^2 with depth. Currently, the GL90 parameterization is only implemented in stacked shallow water (SSW) mode, in which case we have 1/N^2 = h/g'. More specifically, this commit adds a new subroutine that computes the couping coefficient associated with GL90 via a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' or a_cpl_gl90 = nu / h = f^2 * alpha / h. Further, a_cpl_gl90 is multiplied by a function (botfn), which is 0 within the GL90 bottom boundary layer, whose depth is set by Hbbl_gl90, and 1 otherwise. This modification is necessary to avlid fluxing momentum into vanished layers that ride over steep topography. Finally, a_cpl_gl90 is added to a_cpl, where the latter is the coupling coefficient associated with the remaining vertical stresses, used in the vertical viscosity solver. More information can be found in Loose et al. (https://www.essoar.org/doi/abs/10.1002/essoar.10512867.1), Appendix B. New diagnostics: * au_gl90_visc: zonal viscous coupling coefficient associated with GL90, is contained in au_visc * av_gl90_visc: meridional viscous coupling coefficient associated with GL90, is contained in av_visc * Kv_gl90_u: GL90 vertical viscosity at u-points, is contained in Kv_u * Kv_gl90_v: GL90 vertical viscosity at v-points, is contained in Kv_v * du_dt_visc_gl90: zonal acceleration due to GL90 vertical viscosity, included in du_dt_visc * dv_dt_visc_gl90: meridional acceleration due to GL90 vertical viscosity, included in dv_dt_visc * GLwork: Kinetic Energy Source from GL90 Vertical Viscosity The energetics of the GL90 parameterization (named "GLwork") are intentionally computed in MOM_vert_friction, rather than in MOM_diagnostics, where the reamining kinetic energy budget terms are computed. We have to do the computation in MOM_vert_friction to ensure sign- definiteness when GLwork is summed in the vertical. Indeed, MOM_diagnostics does not have access to the velocities and thicknesses used in the vertical solver, but rather uses a time-mean barotropic transport [uv]h to compute the energy budget diagnostics. A detailed discussion and exploration of this issue can be found in https://github.com/ocean-eddy-cpt/MOM6/issues/25. As a result of not computing the energetics in MOM_diagnostics, GLwork is not exactly contained in KE_visc. KE_visc represents the energetics of all vertical viscosity contributions, including the GL90 vertical viscosity. We could implement a term "KE_visc_gl90" that can be 1-to-1 compared to KE_visc; that is, KE_visc - KE_visc_gl90 would represent exactly the energetics of all viscosity contributions EXCEPT the GL90 viscosity. If we implemented KE_visc_gl90, this term would in practice be very similar as GLwork, but sign-definiteness is not ensured, see above. --- src/core/MOM_variables.F90 | 4 + .../vertical/MOM_vert_friction.F90 | 184 +++++++++++++++++- 2 files changed, 182 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 8279afa954..35cdf3038a 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -168,6 +168,10 @@ module MOM_variables PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] + du_dt_visc_gl90 => NULL(), &!< Zonal acceleration due to GL90 vertical viscosity + ! (is included in du_dt_visc) [L T-2 ~> m s-2] + dv_dt_visc_gl90 => NULL(), &!< Meridional acceleration due to GL90 vertical viscosity + ! (is included in dv_dt_visc) [L T-2 ~> m s-2] du_dt_str => NULL(), & !< Zonal acceleration due to the surface stress (included !! in du_dt_visc) [L T-2 ~> m s-2] dv_dt_str => NULL(), & !< Meridional acceleration due to the surface stress (included diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index bc8ef7e893..88be824885 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -7,6 +7,8 @@ module MOM_vert_friction 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, query_averaging_enabled +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : To_North, To_East use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -156,11 +158,14 @@ module MOM_vert_friction real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 T-1 ~> m2 s-1] !>@{ Diagnostic identifiers - integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 + integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1 + integer :: id_GLwork = -1 + integer :: id_au_vv = -1, id_av_vv = -1, id_au_gl90_vv = -1, id_av_gl90_vv = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 + integer :: id_Kv_gl90_u = -1, id_Kv_gl90_v = -1 ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 @@ -171,6 +176,7 @@ module MOM_vert_friction type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure !! for recording accelerations leading to velocity truncations + type(group_pass_type) :: pass_KE_uv !< A handle used for group halo passes end type vertvisc_CS contains @@ -359,6 +365,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. 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(:,:,:) :: KE_term ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real, allocatable, dimension(:,:,:) :: KE_u ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real, allocatable, dimension(:,:,:) :: KE_v ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -373,6 +385,14 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + if (CS%id_GLwork > 0) then + allocate(KE_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + allocate(KE_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + allocate(KE_term(G%isd:G%ied,G%jsd:G%jed,GV%ke), source=0.0) + if (.not.G%symmetric) & + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) + endif + if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix @@ -412,7 +432,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif - + if (associated(ADp%du_dt_visc_gl90)) then ; do k=1,nz ; do I=Isq,Ieq + ADp%du_dt_visc_gl90(I,j,k) = u(I,j,k) + enddo ; enddo ; endif if (associated(ADp%du_dt_str)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_str(I,j,k) = 0.0 enddo ; enddo ; endif @@ -501,6 +523,46 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo endif + ! compute vertical velocity tendency that arises from GL90 viscosity; + ! follow tridiagonal solve method as above; to avoid corrupting u, + ! use ADp%du_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + if (associated(ADp%du_dt_visc_gl90)) then + do I=Isq,Ieq ; if (do_i(I)) then + b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1)) + endif ; enddo + do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then + c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & + dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) + endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90 + do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_visc_gl90(I,j,k) = ADp%du_dt_visc_gl90(I,j,k) + c1(I,k+1) * ADp%du_dt_visc_gl90(I,j,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then + ! now fill ADp%du_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + ! and ADp%du_dt_visc_gl90(I,j,k) the updated velocity due to GL90 + ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 + endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by u*h, where u is original velocity before + ! velocity update; note that ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + if (CS%id_GLwork > 0) then + do k=1,nz; do I=Isq,Ieq ; if (do_i(I)) then + KE_u(I,j,k) = ADp%du_dt_visc(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + endif ; enddo ; enddo + endif + endif + endif + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt if (abs(ADp%du_dt_visc(I,j,k)) < accel_underflow) ADp%du_dt_visc(I,j,k) = 0.0 @@ -542,7 +604,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif - + if (associated(ADp%dv_dt_visc_gl90)) then ; do k=1,nz ; do i=is,ie + ADp%dv_dt_visc_gl90(i,J,k) = v(i,J,k) + enddo ; enddo ; endif if (associated(ADp%dv_dt_str)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_str(i,J,k) = 0.0 enddo ; enddo ; endif @@ -601,6 +665,47 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo endif + ! compute vertical velocity tendency that arises from GL90 viscosity; + ! follow tridiagonal solve method as above; to avoid corrupting v, + ! use ADp%dv_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + if (associated(ADp%dv_dt_visc_gl90)) then + do i=is,ie ; if (do_i(i)) then + b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1)) + endif ; enddo + do k=2,nz ; do i=is,ie ; if (do_i(i)) then + c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & + dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) + endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90 + do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_visc_gl90(i,J,k) = ADp%dv_dt_visc_gl90(i,J,k) + c1(i,k+1) * ADp%dv_dt_visc_gl90(i,J,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! now fill ADp%dv_dt_visc_gl90(i,J,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%dv_dt_visc(i,J,k) holds the original velocity value v(i,J,k) + ! and ADp%dv_dt_visc_gl90(i,J,k) the updated velocity due to GL90 + ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 + endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by v*h, where u is original velocity before + ! velocity update; note that ADp%dv_dt_visc(I,j,k) holds the original velocity value v(i,J,k) + if (CS%id_GLwork > 0) then + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) + KE_v(I,j,k) = ADp%dv_dt_visc(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + endif ; enddo ; enddo + endif + endif + endif + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt if (abs(ADp%dv_dt_visc(i,J,k)) < accel_underflow) ADp%dv_dt_visc(i,J,k) = 0.0 @@ -626,6 +731,23 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ! end of v-component J loop + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + ! We do the KE-rate calculation here (rather than in MOM_diagnostics) to ensure + ! a sign-definite term. MOM_diagnostics does not have access to the velocities + ! and thicknesses used in the vertical solver, but rather uses a time-mean + ! barotropic transport [uv]h. + if (CS%id_GLwork > 0) then + if (.not.G%symmetric) & + call do_group_pass(CS%pass_KE_uv, G%domain) + do k=1,nz + do j=js,je ; do i=is,ie + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * (KE_u(I,j,k) + KE_u(I-1,j,k) + KE_v(i,J,k) + KE_v(i,J-1,k)) + enddo ; enddo + enddo + call post_data(CS%id_GLwork, KE_term, CS%diag) + endif + call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS) ! Here the velocities associated with open boundary conditions are applied. @@ -651,8 +773,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (query_averaging_enabled(CS%diag)) then if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) + if (CS%id_du_dt_visc_gl90 > 0) & + call post_data(CS%id_du_dt_visc_gl90, ADp%du_dt_visc_gl90, CS%diag) if (CS%id_dv_dt_visc > 0) & call post_data(CS%id_dv_dt_visc, ADp%dv_dt_visc, CS%diag) + if (CS%id_dv_dt_visc_gl90 > 0) & + call post_data(CS%id_dv_dt_visc_gl90, ADp%dv_dt_visc_gl90, CS%diag) if (present(taux_bot) .and. (CS%id_taux_bot > 0)) & call post_data(CS%id_taux_bot, taux_bot, CS%diag) if (present(tauy_bot) .and. (CS%id_tauy_bot > 0)) & @@ -868,6 +994,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior [nondim]. @@ -911,6 +1039,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_v > 0) allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + if (CS%id_Kv_gl90_u > 0) allocate(Kv_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + + if (CS%id_Kv_gl90_v > 0) allocate(Kv_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) @@ -1106,7 +1238,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif - + ! Diagnose GL90 Kv at u-points + if (CS%id_Kv_gl90_u > 0) then + do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) + enddo ; enddo + endif enddo @@ -1297,7 +1434,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif - + ! Diagnose GL90 Kv at v-points + if (CS%id_Kv_gl90_v > 0) then + do k=1,nz ; do i=is,ie + if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) + enddo ; enddo + endif enddo ! end of v-point j loop if (CS%debug) then @@ -1316,8 +1458,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) + if (CS%id_Kv_gl90_u > 0) call post_data(CS%id_Kv_gl90_u, Kv_gl90_u, CS%diag) + if (CS%id_Kv_gl90_v > 0) call post_data(CS%id_Kv_gl90_v, Kv_gl90_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) + if (CS%id_au_gl90_vv > 0) call post_data(CS%id_au_gl90_vv, CS%a_u_gl90, CS%diag) + if (CS%id_av_gl90_vv > 0) call post_data(CS%id_av_gl90_vv, CS%a_v_gl90, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) if (CS%id_h_v > 0) call post_data(CS%id_h_v, CS%h_v, CS%diag) if (CS%id_hML_u > 0) call post_data(CS%id_hML_u, hML_u, CS%diag) @@ -2292,12 +2438,24 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + CS%id_Kv_gl90_u = register_diag_field('ocean_model', 'Kv_gl90_u', diag%axesCuL, Time, & + 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & + 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + CS%id_au_gl90_vv = register_diag_field('ocean_model', 'au_gl90_visc', diag%axesCui, Time, & + 'Zonal Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + + CS%id_av_gl90_vv = register_diag_field('ocean_model', 'av_gl90_visc', diag%axesCvi, Time, & + 'Meridional Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', & thickness_units, conversion=GV%H_to_MKS) @@ -2322,7 +2480,21 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, Time, & 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) - + CS%id_GLwork = register_diag_field('ocean_model', 'GLwork', diag%axesTL, Time, & + 'Kinetic Energy Source from GL90 Vertical Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + CS%id_du_dt_visc_gl90 = register_diag_field('ocean_model', 'du_dt_visc_gl90', diag%axesCuL, Time, & + 'Zonal Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) + endif + CS%id_dv_dt_visc_gl90 = register_diag_field('ocean_model', 'dv_dt_visc_gl90', diag%axesCvL, Time, & + 'Meridional Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) + endif CS%id_du_dt_str = register_diag_field('ocean_model', 'du_dt_str', diag%axesCuL, Time, & 'Zonal Acceleration from Surface Wind Stresses', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_str > 0) call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) From 1d918b651ab2c42ba7eab540c7f1ed95d7605b44 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Thu, 12 Jan 2023 14:29:36 -0500 Subject: [PATCH 128/213] Updates to ODA driver suggested by @Hallberg-NOAA Issue#277 (#297) These changes follow suggestions from @Hallberg-NOAA for clarity in documentation and code readability. These modifications should not impact existing applications (e.g. SPEAR) which are reliant on this code. --- src/core/MOM.F90 | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 135 +++++++++++++----------- 2 files changed, 75 insertions(+), 62 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c0ff15e858..07538cdec2 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1456,7 +1456,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (CS%debug) then call MOM_thermo_chksum("Pre-oda ", tv, G, US, haloshift=0) endif - call apply_oda_tracer_increments(US%T_to_s*dtdia, Time_end_thermo, G, GV, tv, h, CS%odaCS) + call apply_oda_tracer_increments(dtdia, Time_end_thermo, G, GV, tv, h, CS%odaCS) if (CS%debug) then call MOM_thermo_chksum("Post-oda ", tv, G, US, haloshift=0) endif diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 4ad11592f9..8a1aab3328 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -103,8 +103,12 @@ module MOM_oda_driver_mod type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA type(grid_type), pointer :: oda_grid !< local tracer grid real, pointer, dimension(:,:,:) :: h => NULL() ! m or kg m-2] for DA - type(thermo_var_ptrs), pointer :: tv => NULL() !< pointer to thermodynamic variables - type(thermo_var_ptrs), pointer :: tv_bc => NULL() !< pointer to thermodynamic bias correction + real, pointer, dimension(:,:,:) :: T_tend => NULL() ! degC s-1] + real, pointer, dimension(:,:,:) :: S_tend => NULL() ! ppt s-1] + real, pointer, dimension(:,:,:) :: T_bc_tend => NULL() !< The layer temperature tendency due + !! to bias adjustment [C T-1 ~> degC s-1] + real, pointer, dimension(:,:,:) :: S_bc_tend => NULL() !< The layer salinity tendency due + !! to bias adjustment [S T-1 ~> ppt s-1] integer :: ni !< global i-direction grid size integer :: nj !< global j-direction grid size logical :: reentrant_x !< grid is reentrant in the x direction @@ -120,7 +124,7 @@ module MOM_oda_driver_mod integer :: ensemble_id = 0 !< id of the current ensemble member integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members - integer :: assim_frequency !< analysis interval in hours + real :: assim_interval !< analysis interval [ T ~> s] ! Profiles local to the analysis domain type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles @@ -198,8 +202,15 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) call get_param(PF, mdl, "ASSIM_METHOD", assim_method, & "String which determines the data assimilation method "//& "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM') - call get_param(PF, mdl, "ASSIM_FREQUENCY", CS%assim_frequency, & - "data assimilation frequency in hours") + call get_param(PF, mdl, "ASSIM_INTERVAL", CS%assim_interval, & + "data assimilation update interval in hours",default=-1.0,units="hours",scale=3600.*US%s_to_T) + if (CS%assim_interval < 0.) then + call get_param(PF, mdl, "ASSIM_FREQUENCY", CS%assim_interval, & + "data assimilation update in hours. This parameter name will \n"//& + "be deprecated in the future. ASSIM_INTERVAL should be used instead.",default=-1.0, & + units="hours",scale=3600.*US%s_to_T) + endif + call get_param(PF, mdl, "USE_REGRIDDING", CS%use_ALE_algorithm , & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) @@ -338,9 +349,9 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) ! assign thicknesses call ALE_initThicknessToCoord(CS%ALE_CS, G, CS%GV, CS%h) endif - allocate(CS%tv) - allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke), source=0.0) - allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke), source=0.0) + + allocate(CS%T_tend(isd:ied,jsd:jed,CS%GV%ke), source=0.0) + allocate(CS%S_tend(isd:ied,jsd:jed,CS%GV%ke), source=0.0) ! call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) ! missing in Feiyu's fork allocate(CS%oda_grid) CS%oda_grid%x => CS%Grid%geolonT @@ -387,9 +398,9 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) CS%INC_CS%fldno = 2 if (CS%nk /= fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') - allocate(CS%tv_bc) ! storage for increment - allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) - allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + + allocate(CS%T_bc_tend(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%S_bc_tend(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -468,17 +479,15 @@ end subroutine set_prior_tracer !> Returns posterior adjustments or full state !!Note that only those PEs associated with an ensemble member receive data -subroutine get_posterior_tracer(Time, CS, h, tv, increment) +subroutine get_posterior_tracer(Time, CS, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), pointer, optional :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), pointer, optional :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: increment !< True if returning increment only type(ocean_control_struct), pointer :: Ocean_increment=>NULL() integer :: m logical :: get_inc - integer :: seconds_per_hour = 3600. + ! return if not analysis time (retain pointers for h and tv) if (Time < CS%Time .or. CS%assim_method == NO_ASSIM) return @@ -487,7 +496,7 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) !! switch to global pelist call set_PElist(CS%filter_pelist) call MOM_mesg('Getting posterior') - if (present(h)) h => CS%h ! get analysis thickness + !! Calculate and redistribute increments to CS%tv right after assimilation !! Retain CS%tv to calculate increments for IAU updates CS%tv_inc otherwise get_inc = .true. @@ -503,30 +512,27 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) do m=1,CS%ensemble_size if (get_inc) then call redistribute_array(CS%mpp_domain, Ocean_increment%T(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + CS%domains(m)%mpp_domain, CS%T_tend, complete=.true.) call redistribute_array(CS%mpp_domain, Ocean_increment%S(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + CS%domains(m)%mpp_domain, CS%S_tend, complete=.true.) else call redistribute_array(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + CS%domains(m)%mpp_domain, CS%T_tend, complete=.true.) call redistribute_array(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + CS%domains(m)%mpp_domain, CS%S_tend, complete=.true.) endif enddo - if (present(tv)) tv => CS%tv - if (present(h)) h => CS%h - !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) - call pass_var(CS%tv%T,CS%domains(CS%ensemble_id)) - call pass_var(CS%tv%S,CS%domains(CS%ensemble_id)) + call pass_var(CS%T_tend,CS%domains(CS%ensemble_id)) + call pass_var(CS%S_tend,CS%domains(CS%ensemble_id)) !convert to a tendency (degC or PSU per second) - CS%tv%T = CS%tv%T / (CS%assim_frequency * seconds_per_hour) - CS%tv%S = CS%tv%S / (CS%assim_frequency * seconds_per_hour) + CS%T_tend = CS%T_tend / (CS%assim_interval) + CS%S_tend = CS%S_tend / (CS%assim_interval) end subroutine get_posterior_tracer @@ -560,21 +566,22 @@ subroutine get_bias_correction_tracer(Time, US, CS) type(ODA_CS), pointer :: CS !< ocean DA control structure ! Local variables - real, allocatable, dimension(:,:,:) :: T_bias ! Temperature biases [C ~> degC] - real, allocatable, dimension(:,:,:) :: S_bias ! Salinity biases [C ~> degC] - real, allocatable, dimension(:,:,:) :: mask_z ! Missing value mask on the horizontal model grid - ! and input-file vertical levels [nondim] + real, allocatable, dimension(:,:,:) :: T_bias ! Estimated temperature tendency bias [C T-1 ~> degC s-1] + real, allocatable, dimension(:,:,:) :: S_bias ! Estimated salinity tendency bias [S T-1 ~> ppt s-1] + real, allocatable, dimension(:,:,:) :: valid_flag ! Valid value flag on the horizontal model grid + ! and input-file vertical levels [nondim] real, allocatable, dimension(:), target :: z_in ! Cell center depths for input data [Z ~> m] real, allocatable, dimension(:), target :: z_edges_in ! Cell edge depths for input data [Z ~> m] real :: missing_value ! A value indicating that there is no valid input data at this point [CU ~> conc] integer, dimension(3) :: fld_sz integer :: i,j,k + call cpu_clock_begin(id_clock_bias_adjustment) call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id, Time, CS%G, T_bias, & - mask_z, z_in, z_edges_in, missing_value, scale=US%degC_to_C, spongeOngrid=.true.) + valid_flag, z_in, z_edges_in, missing_value, scale=US%degC_to_C*US%s_to_T, spongeOngrid=.true.) call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id, Time, CS%G, S_bias, & - mask_z, z_in, z_edges_in, missing_value, scale=US%ppt_to_S, spongeOngrid=.true.) + valid_flag, z_in, z_edges_in, missing_value, scale=US%ppt_to_S*US%s_to_T, spongeOngrid=.true.) ! This should be replaced to use mask_z instead of the following lines ! which are intended to zero land values using an arbitrary limit. @@ -582,17 +589,21 @@ subroutine get_bias_correction_tracer(Time, US, CS) do i=1,fld_sz(1) do j=1,fld_sz(2) do k=1,fld_sz(3) - if (T_bias(i,j,k) > 1.0E-3*US%degC_to_C) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) > 1.0E-3*US%ppt_to_S) S_bias(i,j,k) = 0.0 +! if (T_bias(i,j,k) > 1.0E-3*US%degC_to_C) T_bias(i,j,k) = 0.0 +! if (S_bias(i,j,k) > 1.0E-3*US%ppt_to_S) S_bias(i,j,k) = 0.0 + if (valid_flag(i,j,k)==0.) then + T_bias(i,j,k)=0.0 + S_bias(i,j,k)=0.0 + endif enddo enddo enddo - CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier - CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + CS%T_bc_tend = T_bias * CS%bias_adjustment_multiplier + CS%S_bc_tend = S_bias * CS%bias_adjustment_multiplier - call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) - call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + call pass_var(CS%T_bc_tend, CS%domains(CS%ensemble_id)) + call pass_var(CS%S_bc_tend, CS%domains(CS%ensemble_id)) call cpu_clock_end(id_clock_bias_adjustment) @@ -640,8 +651,8 @@ subroutine set_analysis_time(Time,CS) integer :: yr, mon, day, hr, min, sec if (Time >= CS%Time) then - ! increment the analysis time to the next step converting to seconds - CS%Time = CS%Time + real_to_time(CS%US%T_to_s*(CS%assim_frequency*3600.)) + ! increment the analysis time to the next step + CS%Time = CS%Time + real_to_time(CS%US%T_to_s*(CS%assim_interval)) call get_date(Time, yr, mon, day, hr, min, sec) write(mesg,*) 'Model Time: ', yr, mon, day, hr, min, sec @@ -662,7 +673,7 @@ end subroutine set_analysis_time !> Apply increments to tracers subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) - real, intent(in) :: dt !< The tracer timestep [s] + real, intent(in) :: dt !< The tracer timestep [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -674,12 +685,14 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) !! local variables integer :: i, j integer :: isc, iec, jsc, jec - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_inc !< an adjustment to the temperature + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_tend_inc !< an adjustment to the temperature !! tendency [C T-1 -> degC s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_inc !< an adjustment to the salinity + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_tend_inc !< an adjustment to the salinity !! tendency [S T-1 -> ppt s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T_tend !< The temperature tendency adjustment from + !! DA [C T-1 ~> degC s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S_tend !< The salinity tendency adjustment from DA + !! [S T-1 ~> ppt s-1] real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] if (.not. associated(CS)) return @@ -687,14 +700,14 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) call cpu_clock_begin(id_clock_apply_increments) - T_inc(:,:,:) = 0.0; S_inc(:,:,:) = 0.0; T(:,:,:) = 0.0; S(:,:,:) = 0.0 + T_tend_inc(:,:,:) = 0.0; S_tend_inc(:,:,:) = 0.0; T_tend(:,:,:) = 0.0; S_tend(:,:,:) = 0.0 if (CS%assim_method > 0 ) then - T = T + CS%tv%T - S = S + CS%tv%S + T_tend = T_tend + CS%T_tend + S_tend = S_tend + CS%S_tend endif if (CS%do_bias_adjustment ) then - T = T + CS%tv_bc%T - S = S + CS%tv_bc%S + T_tend = T_tend + CS%T_bc_tend + S_tend = S_tend + CS%S_bc_tend endif if (CS%answer_date >= 20190101) then @@ -707,25 +720,25 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) isc=G%isc; iec=G%iec; jsc=G%jsc; jec=G%jec do j=jsc,jec; do i=isc,iec - call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T(i,j,:), & - G%ke, h(i,j,:), T_inc(i,j,:), h_neglect, h_neglect_edge) - call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S(i,j,:), & - G%ke, h(i,j,:), S_inc(i,j,:), h_neglect, h_neglect_edge) + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T_tend(i,j,:), & + G%ke, h(i,j,:), T_tend_inc(i,j,:), h_neglect, h_neglect_edge) + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S_tend(i,j,:), & + G%ke, h(i,j,:), S_tend_inc(i,j,:), h_neglect, h_neglect_edge) enddo; enddo - call pass_var(T_inc, G%Domain) - call pass_var(S_inc, G%Domain) + call pass_var(T_tend_inc, G%Domain) + call pass_var(S_tend_inc, G%Domain) - tv%T(isc:iec,jsc:jec,:) = tv%T(isc:iec,jsc:jec,:) + T_inc(isc:iec,jsc:jec,:)*dt - tv%S(isc:iec,jsc:jec,:) = tv%S(isc:iec,jsc:jec,:) + S_inc(isc:iec,jsc:jec,:)*dt + tv%T(isc:iec,jsc:jec,:) = tv%T(isc:iec,jsc:jec,:) + T_tend_inc(isc:iec,jsc:jec,:)*dt + tv%S(isc:iec,jsc:jec,:) = tv%S(isc:iec,jsc:jec,:) + S_tend_inc(isc:iec,jsc:jec,:)*dt call pass_var(tv%T, G%Domain) call pass_var(tv%S, G%Domain) call enable_averaging(dt, Time_end, CS%diag_CS) - if (CS%id_inc_t > 0) call post_data(CS%id_inc_t, T_inc, CS%diag_CS) - if (CS%id_inc_s > 0) call post_data(CS%id_inc_s, S_inc, CS%diag_CS) + if (CS%id_inc_t > 0) call post_data(CS%id_inc_t, T_tend_inc, CS%diag_CS) + if (CS%id_inc_s > 0) call post_data(CS%id_inc_s, S_tend_inc, CS%diag_CS) call disable_averaging(CS%diag_CS) call diag_update_remap_grids(CS%diag_CS) From 237194dfdeb4d20e907509645e83fee8f5c92472 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 4 Jan 2023 10:23:52 -0500 Subject: [PATCH 129/213] +Add DOME_tracer and tracer_example runtime params Added the new runtime parameters DOME_TRACER_STRIPE_WIDTH, DOME_TRACER_STRIPE_LAT and DOME_TRACER_SHEET_SPACING to specify the previously hard-coded dimensional parameters in the DOME_tracer module, and added the runtime parameters TRACER_EXAMPLE_STRIPE_WIDTH and TRACER_EXAMPLE_STRIPE_LAT to specify parameters used by tracer_example. This change requires that an ocean grid type be passed to register_DOME_tracer and USER_register_tracer_example instead of a hor_index type. Descriptions of the units of a number of internal variables were added to both modules. In addition, the confusing (and dimensionally heterogeneous) trdc array in tracer_column_physics was replaced with 3 internal variables with more suggestive names. By default all answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files for cases that have USE_DOME_TRACER=True or USE_USER_TRACER_EXAMPLE=True. --- src/tracer/DOME_tracer.F90 | 65 ++++++++++------ src/tracer/MOM_tracer_flow_control.F90 | 7 +- src/tracer/tracer_example.F90 | 104 +++++++++++++------------ 3 files changed, 100 insertions(+), 76 deletions(-) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index d1c6ebd7bf..98788843e3 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -42,10 +42,18 @@ module DOME_tracer character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? - real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, perhaps in [g kg-1] + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out, perhaps in [g kg-1] logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. + real :: stripe_width !< The meridional width of the vertical stripes in the initial condition + !! for some of the DOME tracers, in [km] or [degrees_N] or [m]. + real :: stripe_s_lat !< The southern latitude of the first vertical stripe in the initial condition + !! for some of the DOME tracers, in [km] or [degrees_N] or [m]. + real :: sheet_spacing !< The vertical spacing between successive horizontal sheets of tracer in the initial + !! conditions for some of the DOME tracers [Z ~> m], and twice the thickness of + !! these horizontal tracer sheets + integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. @@ -58,14 +66,15 @@ module DOME_tracer contains !> Register tracer fields and subroutines to be used with MOM. -function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(DOME_tracer_CS), pointer :: CS !< A pointer that is set to point to the +function register_DOME_tracer(G, GV, US, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(DOME_tracer_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname @@ -75,10 +84,10 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. character(len=200) :: inputdir - real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to the tracer field + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] logical :: register_DOME_tracer integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "DOME_register_tracer called with an "// & @@ -99,6 +108,16 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call log_param(param_file, mdl, "INPUTDIR/DOME_TRACER_IC_FILE", & CS%tracer_IC_file) endif + call get_param(param_file, mdl, "DOME_TRACER_STRIPE_WIDTH", CS%stripe_width, & + "The meridional width of the vertical stripes in the initial condition "//& + "for the DOME tracers.", units=G%y_ax_unit_short, default=50.0) + call get_param(param_file, mdl, "DOME_TRACER_STRIPE_LAT", CS%stripe_s_lat, & + "The southern latitude of the first vertical stripe in the initial condition "//& + "for the DOME tracers.", units=G%y_ax_unit_short, default=350.0) + call get_param(param_file, mdl, "DOME_TRACER_SHEET_SPACING", CS%sheet_spacing, & + "The vertical spacing between successive horizontal sheets of tracer in the initial "//& + "conditions for the DOME tracers, and twice the thickness of these tracer sheets.", & + units="m", default=600.0, scale=US%m_to_Z) call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. "//& "The exact location and properties of those sponges are "//& @@ -118,7 +137,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for horizontal advection, diffusion, and restarts. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., restart_CS=restart_CS, & flux_units=trim(flux_units), flux_scale=GV%H_to_MKS) @@ -154,16 +173,16 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables - real, allocatable :: temp(:,:,:) + real, allocatable :: temp(:,:,:) ! Target values for the tracers in the sponges, perhaps in [g kg-1] character(len=16) :: name ! A variable's name in a NetCDF file. - real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to the tracer field - real :: tr_y ! Initial zonally uniform tracer concentrations. + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] + real :: tr_y ! Initial zonally uniform tracer concentrations, perhaps in [g kg-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: e(SZK_(GV)+1) ! Interface heights relative to the sea surface (negative down) [Z ~> m] real :: e_top ! Height of the top of the tracer band relative to the sea surface [Z ~> m] real :: e_bot ! Height of the bottom of the tracer band relative to the sea surface [Z ~> m] - real :: d_tr ! A change in tracer concentrations, in tracer units. + real :: d_tr ! A change in tracer concentrations, in tracer units, perhaps [g kg-1] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -194,24 +213,25 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & enddo ! This sets a stripe of tracer across the basin. - do m=2,NTR ; do j=js,je ; do i=is,ie + do m=2,min(6,NTR) ; do j=js,je ; do i=is,ie tr_y = 0.0 - if ((m <= 6) .and. (G%geoLatT(i,j) > (300.0+50.0*real(m-1))) .and. & - (G%geoLatT(i,j) < (350.0+50.0*real(m-1)))) tr_y = 1.0 + if ((G%geoLatT(i,j) > (CS%stripe_s_lat + CS%stripe_width*real(m-2))) .and. & + (G%geoLatT(i,j) < (CS%stripe_s_lat + CS%stripe_width*real(m-1)))) & + tr_y = 1.0 do k=1,nz ! This adds the stripes of tracer to every layer. CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + tr_y enddo enddo ; enddo ; enddo - if (NTR > 7) then + if (NTR >= 7) then do j=js,je ; do i=is,ie e(1) = 0.0 do k=1,nz e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z do m=7,NTR - e_top = (-600.0*real(m-1) + 3000.0) * US%m_to_Z - e_bot = (-600.0*real(m-1) + 2700.0) * US%m_to_Z + e_top = -CS%sheet_spacing * (real(m-6)) + e_bot = -CS%sheet_spacing * (real(m-6) + 0.5) if (e_top < e(K)) then if (e_top < e(K+1)) then ; d_tr = 0.0 elseif (e_bot < e(K+1)) then @@ -255,8 +275,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! do m=1,NTR do m=1,1 - ! This is needed to force the compiler not to do a copy in the sponge - ! calls. Curses on the designers and implementers of Fortran90. + ! This pointer is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) call set_up_sponge_field(temp, tr_ptr, G, GV, nz, sponge_CSp) enddo diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index bf7076d4bb..aa3e359355 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -178,8 +178,7 @@ subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", & - CS%use_USER_tracer_example, & + call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", CS%use_USER_tracer_example, & "If true, use the USER_tracer_example tracer package.", & default=.false.) call get_param(param_file, mdl, "USE_DOME_TRACER", CS%use_DOME_tracer, & @@ -230,10 +229,10 @@ subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_CS) ! tracer package registration call returns a logical false if it cannot be run ! for some reason. This then overrides the run-time selection from above. if (CS%use_USER_tracer_example) CS%use_USER_tracer_example = & - USER_register_tracer_example(G%HI, GV, param_file, CS%USER_tracer_example_CSp, & + USER_register_tracer_example(G, GV, US, param_file, CS%USER_tracer_example_CSp, & tr_Reg, restart_CS) if (CS%use_DOME_tracer) CS%use_DOME_tracer = & - register_DOME_tracer(G%HI, GV, param_file, CS%DOME_tracer_CSp, & + register_DOME_tracer(G, GV, US, param_file, CS%DOME_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ISOMIP_tracer) CS%use_ISOMIP_tracer = & register_ISOMIP_tracer(G%HI, GV, param_file, CS%ISOMIP_tracer_CSp, & diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 335f82a59b..fa9b978f9c 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -39,8 +39,13 @@ module USER_tracer_example !! to initialize internally. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? - real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, perhaps in [g kg-1]? + real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out, perhaps in [g kg-1]? + + real :: stripe_width !< The Gaussian width of the stripe in the initial condition + !! for the tracer_example tracers [L ~> m] + real :: stripe_lat !< The central latitude of the stripe in the initial condition + !! for the tracer_example tracers, in [degrees_N] or [km] or [m]. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the @@ -54,16 +59,17 @@ module USER_tracer_example contains !> This subroutine is used to register tracer fields and subroutines to be used with MOM. -function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure +function USER_register_tracer_example(G, GV, US, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(USER_tracer_example_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname @@ -73,10 +79,10 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS character(len=200) :: inputdir character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] logical :: USER_register_tracer_example integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "USER_register_tracer_example called with an "// & @@ -87,9 +93,9 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "TRACER_EXAMPLE_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial "//& - "conditions for the DOME tracers, or blank to initialize "//& - "them internally.", default=" ") + "The name of a file from which to read the initial conditions for "//& + "the tracer_example tracers, or blank to initialize them internally.", & + default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%tracer_IC_file = trim(slasher(inputdir))//trim(CS%tracer_IC_file) @@ -100,6 +106,12 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS "If true, sponges may be applied anywhere in the domain. "//& "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) + call get_param(param_file, mdl, "TRACER_EXAMPLE_STRIPE_WIDTH", CS%stripe_width, & + "The Gaussian width of the stripe in the initial condition for the "//& + "tracer_example tracers.", units="m", default=1.0e5, scale=US%m_to_L) + call get_param(param_file, mdl, "TRACER_EXAMPLE_STRIPE_LAT", CS%stripe_lat, & + "The central latitude of the stripe in the initial condition for the "//& + "tracer_example tracers.", units=G%y_ax_unit_short, default=40.0) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) @@ -113,11 +125,10 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS if (GV%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1" else ; flux_units = "kg s-1" ; endif - ! This is needed to force the compiler not to do a copy in the registration - ! calls. Curses on the designers and implementers of Fortran90. + ! This pointer is needed to force the compiler not to do a copy in the registration calls. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for horizontal advection, diffusion, and restarts. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., flux_units=flux_units, & restart_CS=restart_CS) @@ -157,11 +168,11 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & !! for the sponges, if they are in use. ! Local variables - real, allocatable :: temp(:,:,:) + real, allocatable :: temp(:,:,:) ! Target values for the tracers in the sponges, perhaps in [g kg-1] character(len=32) :: name ! A variable's name in a NetCDF file. - real, pointer :: tr_ptr(:,:,:) => NULL() - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: tr_y ! Initial zonally uniform tracer concentrations. + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] + real :: tr_y ! Initial zonally uniform tracer concentrations, perhaps in [g kg-1] real :: dist2 ! The distance squared from a line [L2 ~> m2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB, lntr @@ -195,9 +206,8 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! This sets a stripe of tracer across the basin. PI = 4.0*atan(1.0) do j=js,je - dist2 = (G%Rad_Earth_L * PI / 180.0)**2 * & - (G%geoLatT(i,j) - 40.0) * (G%geoLatT(i,j) - 40.0) - tr_y = 0.5 * exp( -dist2 / (1.0e5*US%m_to_L)**2 ) + dist2 = (G%Rad_Earth_L * PI / 180.0)**2 * (G%geoLatT(i,j) - CS%stripe_lat)**2 + tr_y = 0.5 * exp( -dist2 / CS%stripe_width**2 ) do k=1,nz ; do i=is,ie ! This adds the stripes of tracer to every layer. @@ -218,7 +228,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & allocate(temp(G%isd:G%ied,G%jsd:G%jed,nz)) do k=1,nz ; do j=js,je ; do i=is,ie - if (G%geoLatT(i,j) > 700.0 .and. (k > nz/2)) then + if ((G%geoLatT(i,j) > 0.5*G%len_lat + G%south_lat) .and. (k > nz/2)) then temp(i,j,k) = 1.0 else temp(i,j,k) = 0.0 @@ -227,8 +237,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! do m=1,NTR do m=1,1 - ! This is needed to force the compiler not to do a copy in the sponge - ! calls. Curses on the designers and implementers of Fortran90. + ! This pointer is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) call set_up_sponge_field(temp, tr_ptr, G, GV, nz, sponge_CSp) enddo @@ -288,28 +297,25 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. + real :: diapyc_filt ! A multiplicative filter that can be set to 0 to disable diapycnal + ! advection of the tracer [nondim] + real :: dye_up ! The tracer concentration of upwelled water, perhaps in [g kg-1]? + real :: dye_down ! The tracer concentration of downwelled water, perhaps in [g kg-1]? integer :: i, j, k, is, ie, js, je, nz, m -! The following array (trdc) determines the behavior of the tracer -! diapycnal advection. The first element is 1 if tracers are -! passively advected. The second and third are the concentrations -! to which downwelling and upwelling water are set, respectively. -! For most (normal) tracers, the appropriate vales are {1,0,0}. - - real :: trdc(3) -! Uncomment the following line to dye both upwelling and downwelling. -! data trdc / 0.0,1.0,1.0 / -! Uncomment the following line to dye downwelling. -! data trdc / 0.0,1.0,0.0 / -! Uncomment the following line to dye upwelling. -! data trdc / 0.0,0.0,1.0 / -! Uncomment the following line for tracer concentrations to be set -! to zero in any diapycnal motions. -! data trdc / 0.0,0.0,0.0 / -! Uncomment the following line for most "physical" tracers, which -! are advected diapycnally in the usual manner. - data trdc / 1.0,0.0,0.0 / + ! These are the settings for most "physical" tracers, which + ! are advected diapycnally in the usual manner. + diapyc_filt = 1.0 ; dye_down = 0.0 ; dye_down = 0.0 + + ! Uncomment the following line to dye downwelling. +! diapyc_filt = 0.0 ; dye_down = 1.0 + ! Uncomment the following line to dye upwelling. +! diapyc_filt = 0.0 ; dye_up = 1.0 + ! Uncomment the following line for tracer concentrations to be set + ! to zero in any diapycnal motions. +! diapyc_filt = 0.0 ; dye_down = 0.0 ; dye_down = 0.0 + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return @@ -330,21 +336,21 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, b_denom_1 = h_old(i,j,1) + ea(i,j,1) + h_neglect b1(i) = 1.0 / (b_denom_1 + eb(i,j,1)) ! d1(i) = b_denom_1 * b1(i) - d1(i) = trdc(1) * (b_denom_1 * b1(i)) + (1.0 - trdc(1)) + d1(i) = diapyc_filt * (b_denom_1 * b1(i)) + (1.0 - diapyc_filt) do m=1,NTR - CS%tr(i,j,1,m) = b1(i)*(hold0(i)*CS%tr(i,j,1,m) + trdc(3)*eb(i,j,1)) + CS%tr(i,j,1,m) = b1(i)*(hold0(i)*CS%tr(i,j,1,m) + dye_up*eb(i,j,1)) ! Add any surface tracer fluxes to the preceding line. enddo enddo do k=2,nz ; do i=is,ie - c1(i,k) = trdc(1) * eb(i,j,k-1) * b1(i) + c1(i,k) = diapyc_filt * eb(i,j,k-1) * b1(i) b_denom_1 = h_old(i,j,k) + d1(i)*ea(i,j,k) + h_neglect b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) - d1(i) = trdc(1) * (b_denom_1 * b1(i)) + (1.0 - trdc(1)) + d1(i) = diapyc_filt * (b_denom_1 * b1(i)) + (1.0 - diapyc_filt) do m=1,NTR CS%tr(i,j,k,m) = b1(i) * (h_old(i,j,k)*CS%tr(i,j,k,m) + & - ea(i,j,k)*(trdc(1)*CS%tr(i,j,k-1,m)+trdc(2)) + & - eb(i,j,k)*trdc(3)) + ea(i,j,k)*(diapyc_filt*CS%tr(i,j,k-1,m) + dye_down) + & + eb(i,j,k)*dye_up) enddo enddo ; enddo do m=1,NTR ; do k=nz-1,1,-1 ; do i=is,ie From 54b07015396d3e508db6eca774829b53d02e1dfe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 4 Jan 2023 17:33:54 -0500 Subject: [PATCH 130/213] Named argument assignment white-space clean-up Removed extra white space around the named argument assignments for default, units or conversion arguments to align with the MOM6 style guide. Only white space is modified, and all answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 4 ++-- src/core/MOM_dynamics_unsplit.F90 | 4 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 ++-- src/core/MOM_verticalGrid.F90 | 2 +- src/framework/MOM_domains.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 2 +- src/parameterizations/lateral/MOM_tidal_forcing.F90 | 2 +- src/parameterizations/vertical/MOM_CVMix_shear.F90 | 2 +- src/tracer/MOM_neutral_diffusion.F90 | 6 +++--- src/user/BFB_surface_forcing.F90 | 2 +- src/user/circle_obcs_initialization.F90 | 2 +- src/user/dumbbell_surface_forcing.F90 | 4 ++-- 14 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 748748f77f..e8909e24f9 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1545,10 +1545,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective U-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive=.true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective V-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive=.true.) if (GV%Boussinesq) then CS%id_deta_dt = register_diag_field('ocean_model', 'deta_dt', diag%axesT1, Time, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index a0a6633811..e6f99cc9d8 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -692,10 +692,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective U Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive=.true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective V Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive=.true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 85f5d6c546..fbf416d13d 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -655,10 +655,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective U-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive=.true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective V-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive=.true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 41d29488cd..f20c7bbd26 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -105,7 +105,7 @@ subroutine verticalGridInit( param_file, GV, US ) log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%Z_to_m*US%m_s_to_L_T**2) + units="m s-2", default=9.80, scale=US%Z_to_m*US%m_s_to_L_T**2) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 47ac43df06..a0f3855d19 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -180,7 +180,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & !$ if (.not.MOM_thread_affinity_set()) then !$ call get_param(param_file, mdl, "OCEAN_OMP_THREADS", ocean_nthreads, & !$ "The number of OpenMP threads that MOM6 will use.", & - !$ default = 1, layoutParam=.true.) + !$ default=1, layoutParam=.true.) !$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, & !$ "If True, use hyper-threading.", default=.false., layoutParam=.true.) !$ call set_MOM_thread_affinity(ocean_nthreads, ocean_omp_hyper_thread) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index bde8e3e219..aaa53dee59 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1468,7 +1468,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) + units="m s-2", default=9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "C_P", CS%Cp, & "The heat capacity of sea water, approximated as a constant. "//& "The default value is from the TEOS-10 definition of conservative temperature.", & diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 552216f41d..6691095b08 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -407,7 +407,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ fail_if_missing=.true.) call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) + units="m s-2", default=9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c0d7e6c50c..b4092d3d43 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -2040,7 +2040,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "is permitted for the thickness diffusivity. 1.0 is the "//& "marginally unstable value in a pure layered model, but "//& "much smaller numbers (e.g. 0.1) seem to work better for "//& - "ALE-based models.", units = "nondimensional", default=0.8) + "ALE-based models.", units="nondimensional", default=0.8) call get_param(param_file, mdl, "KH_ETA_CONST", CS%Kh_eta_bg, & "The background horizontal diffusivity of the interface heights (without "//& diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 520c70172f..63b0ced556 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -393,7 +393,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) if (CS%tidal_sal_from_file .or. CS%use_prev_tides) then call get_param(param_file, mdl, "TIDAL_INPUT_FILE", tidal_input_files, & "A list of input files for tidal information.", & - default = "", fail_if_missing=.true.) + default="", fail_if_missing=.true.) endif call get_param(param_file, mdl, "TIDE_REF_DATE", tide_ref_date, & diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index b69cd2daae..4f13cf5793 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -277,7 +277,7 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & "If true, vertically smooth the Richardson "// & "number by applying a 1-2-1 filter once.", & - default = .false.) + default=.false.) call cvmix_init_shear(mix_scheme=CS%Mix_Scheme, & KPP_nu_zero=US%Z2_T_to_m2_s*CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index cd29e9a536..a34c2a2e58 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -167,7 +167,7 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, call get_param(param_file, mdl, "NDIFF_REF_PRES", CS%ref_pres, & "The reference pressure (Pa) used for the derivatives of "//& "the equation of state. If negative (default), local pressure is used.", & - units="Pa", default = -1., scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=-1., scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "NDIFF_INTERIOR_ONLY", CS%interior_only, & "If true, only applies neutral diffusion in the ocean interior."//& "That is, the algorithm will exclude the surface and bottom"//& @@ -245,10 +245,10 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, call get_param(param_file, mdl, "NDIFF_DEBUG", CS%debug, & "Turns on verbose output for discontinuous neutral "//& "diffusion routines.", & - default = .false.) + default=.false.) call get_param(param_file, mdl, "HARD_FAIL_HEFF", CS%hard_fail_heff, & "Bring down the model if a problem with heff is detected",& - default = .true.) + default=.true.) endif if (CS%interior_only) then diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 818fa63659..f3d04980f6 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -197,7 +197,7 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) + units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index f8e9b342ac..07fc539979 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -64,7 +64,7 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus call get_param(param_file, mdl, "DISK_X_OFFSET", xOffset, & "The x-offset of the initially elevated disk in the "//& "circle_obcs test case.", units=G%x_ax_unit_short, & - default = 0.0, do_not_log=just_read) + default=0.0, do_not_log=just_read) call get_param(param_file, mdl, "DISK_IC_AMPLITUDE", IC_amp, & "Initial amplitude of interface height displacements "//& "in the circle_obcs test case.", & diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 685ffc4bee..0b8f59a6e8 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -201,7 +201,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) + units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -210,7 +210,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DUMBBELL_SLP_AMP", CS%slp_amplitude, & "Amplitude of SLP forcing in reservoirs.", & - units="Pa", default = 10000.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=10000.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "DUMBBELL_SLP_PERIOD", CS%slp_period, & "Periodicity of SLP forcing in reservoirs.", & units="days", default=1.0) From 3a9f6c731cdd1081adf6987cf0cee64ed3ad9d32 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 4 Jan 2023 17:27:40 -0500 Subject: [PATCH 131/213] +Make z_tol arg non-optional to cut_off_column_top Made the previously optional z_tol argument to find_depth_of_pressure_in_cell and cut_off_column_top non-optional. It was already being provided except in a call for unit testing, so adding it as a parameter there led to a simple change and the elimination of a hard-coded dimensional parameter. Also replaced the hard-coded fill values over land in MOM_temp_salt_initialize_from_Z for temperatures and salinities before regridding with the runtime variables temp_land_fill and salt_land_fill that are already being used in the same routine. This does not change any answers, probably because these values are not actually used. All answers are bitwise identical, but some subroutine arguments have been made non-optional. --- src/core/MOM_density_integrals.F90 | 7 +++---- src/initialization/MOM_state_initialization.F90 | 12 +++++++----- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 1e51612e6d..6cffea5c75 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -1550,10 +1550,10 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t !! are anomalous to [R ~> kg m-3] real, intent(in) :: G_e !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] type(EOS_type), intent(in) :: EOS !< Equation of state structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: P_b !< Pressure at the bottom of the cell [R L2 T-2 ~> Pa] real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m] - real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m] + real, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m] ! Local variables real :: dp ! Pressure thickness of the layer [R L2 T-2 ~> Pa] @@ -1583,8 +1583,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.0e-5*US%m_to_Z - if (present(z_tol)) Pa_tol = GxRho * z_tol + Pa_tol = GxRho * z_tol F_guess = F_l - Pa_left / (Pa_right - Pa_left) * (F_r - F_l) Pa = Pa_right - Pa_left ! To get into iterative loop diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 14459f7d0a..0504994a30 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1393,7 +1393,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, real, dimension(nk), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated - real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth + real, intent(in) :: z_tol !< The tolerance with which to find the depth !! matching the specified pressure [Z ~> m]. integer, optional, intent(in) :: remap_answer_date !< The vintage of the order of arithmetic and !! expressions to use for remapping. Values below 20190101 @@ -2809,8 +2809,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land - tmpT1dIn(i,j,k) = -99.9*US%degC_to_C ! Change to temp_land_fill - tmpS1dIn(i,j,k) = -99.9*US%ppt_to_S ! Change to salt_land_fill + tmpT1dIn(i,j,k) = temp_land_fill + tmpS1dIn(i,j,k) = salt_land_fill endif h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k @@ -3129,6 +3129,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) real :: P_tot, P_t, P_b ! Pressures [R L2 T-2 ~> Pa] real :: z_out ! Output height [Z ~> m] real :: I_z_scale ! The inverse of the height scale for prescribed gradients [Z-1 ~> m-1] + real :: z_tol ! The tolerance with which to find the depth matching a specified pressure [Z ~> m]. integer :: k type(remapping_CS), pointer :: remap_CS => NULL() @@ -3143,6 +3144,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) P_tot = 0. T_ref = 20.0*US%degC_to_C S_ref = 35.0*US%ppt_to_S + z_tol = 1.0e-5*US%m_to_Z do k = 1, nk z(k) = 0.5 * ( e(K) + e(K+1) ) T_t(k) = T_ref + (0. * I_z_scale) * e(k) @@ -3159,7 +3161,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), P_t, 0.5*P_tot, & - GV%Rho0, GV%g_Earth, tv%eqn_of_state, US, P_b, z_out) + GV%Rho0, GV%g_Earth, tv%eqn_of_state, US, P_b, z_out, z_tol=z_tol) write(0,*) k, US%RL2_T2_to_Pa*P_t, US%RL2_T2_to_Pa*P_b, 0.5*US%RL2_T2_to_Pa*P_tot, & US%Z_to_m*e(K), US%Z_to_m*e(K+1), US%Z_to_m*z_out P_t = P_b @@ -3171,7 +3173,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) write(0,*) '' write(0,*) GV%H_to_m*h(:) call cut_off_column_top(nk, tv, GV, US, GV%g_Earth, -e(nk+1), GV%Angstrom_Z, & - T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) + T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS, z_tol=z_tol) write(0,*) GV%H_to_m*h(:) end subroutine MOM_state_init_tests From 68aefe134b853b751593267646a8f9dcfb6d6015 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 5 Jan 2023 08:57:02 -0500 Subject: [PATCH 132/213] Revise tc4/MOM_input with updated parameter names Updated tc4/MOM_input to reflect the newer parameter settings, including replacing the obsolete NEW_SPONGES parameter with INTERPOLATE_SPONGE_TIME_SPACE. Without this change, NEW_SPONGES can not be formally and properly obsoleted without breaking the TC testing. All answers and testing are identical with this change. --- .testing/tc4/MOM_input | 142 +++++++++++++++++++---------------------- 1 file changed, 65 insertions(+), 77 deletions(-) diff --git a/.testing/tc4/MOM_input b/.testing/tc4/MOM_input index e33bf40bf6..591ed4c788 100644 --- a/.testing/tc4/MOM_input +++ b/.testing/tc4/MOM_input @@ -1,25 +1,25 @@ ! This file was written by the model and records the non-default parameters used at run-time. ! === module MOM === - -! === module MOM_unit_scaling === -! Parameters for doing unit scaling of variables. USE_REGRIDDING = True ! [Boolean] default = False ! If True, use the ALE algorithm (regridding/remapping). If False, use the ! layered isopycnal algorithm. -DT = 1200.0 ! [s] +DT = 1200.0 ! [s] ! The (baroclinic) dynamics time step. The time-step that is actually used will ! be an integer fraction of the forcing time-step (DT_FORCING in ocean-only mode ! or the coupling timestep in coupled mode.) -DT_THERM = 3600.0 ! [s] default = 300.0 +DT_THERM = 3600.0 ! [s] default = 1200.0 ! The thermodynamic and tracer advection time step. Ideally DT_THERM should be ! an integer multiple of DT and less than the forcing or coupling time-step, ! unless THERMO_SPANS_COUPLING is true, in which case DT_THERM can be an integer - ! multiple of the coupling timestep. By default DT_THERM is set to DT. + ! multiple of the coupling timestep. By default DT_THERM is set to DT. C_P = 3925.0 ! [J kg-1 K-1] default = 3991.86795711963 ! The heat capacity of sea water, approximated as a constant. This is only used ! if ENABLE_THERMODYNAMICS is true. The default value is from the TEOS-10 ! definition of conservative temperature. +USE_PSURF_IN_EOS = False ! [Boolean] default = True + ! If true, always include the surface pressure contributions in equation of + ! state calculations. SAVE_INITIAL_CONDS = False ! [Boolean] default = False ! If true, write the initial conditions to a file given by IC_OUTPUT_FILE. @@ -33,9 +33,6 @@ NJGLOBAL = 10 ! ! The total number of thickness grid points in the y-direction in the physical ! domain. With STATIC_MEMORY_ this is set in MOM_memory.h at compile time. -! === module MOM_hor_index === -! Sets the horizontal array index types. - ! === module MOM_verticalGrid === ! Parameters providing information about the vertical grid. NK = 2 ! [nondim] @@ -65,8 +62,9 @@ TOPO_CONFIG = "file" ! ! wall at the southern face. ! halfpipe - a zonally uniform channel with a half-sine ! profile in the meridional direction. + ! bbuilder - build topography from list of functions. ! benchmark - use the benchmark test case topography. - ! Neverland - use the Neverland test case topography. + ! Neverworld - use the Neverworld test case topography. ! DOME - use a slope and channel configuration for the ! DOME sill-overflow test case. ! ISOMIP - use a slope and channel configuration for the @@ -83,9 +81,6 @@ TOPO_CONFIG = "file" ! !MAXIMUM_DEPTH = 100.0 ! [m] ! The (diagnosed) maximum depth of the ocean. -! === module MOM_open_boundary === -! Controls where open boundaries are located, what kind of boundary condition to impose, and what data to apply, -! if any. ROTATION = "betaplane" ! default = "2omegasinlat" ! This specifies how the Coriolis parameter is specified: ! 2omegasinlat - Use twice the planetary rotation rate @@ -94,6 +89,10 @@ ROTATION = "betaplane" ! default = "2omegasinlat" ! USER - call a user modified routine. F_0 = 1.0E-04 ! [s-1] default = 0.0 ! The reference value of the Coriolis parameter with the betaplane option. +GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = False + ! If true, use an older algorithm to calculate the sine and cosines needed + ! rotate between grid-oriented directions and true north and east. Differences + ! arise at the tripolar fold. ! === module MOM_tracer_registry === @@ -106,12 +105,10 @@ DRHO_DS = 0.0 ! [kg m-3 PSU-1] default = 0.8 ! When EQN_OF_STATE=LINEAR, this is the partial derivative of density with ! salinity. -! === module MOM_restart === - ! === module MOM_tracer_flow_control === ! === module MOM_coord_initialization === -COORD_CONFIG = "linear" ! +COORD_CONFIG = "linear" ! default = "none" ! This specifies how layers are to be defined: ! ALE or none - used to avoid defining layers in ALE mode ! file - read coordinate information from the file @@ -129,6 +126,10 @@ COORD_CONFIG = "linear" ! ! ts_profile - use temperature and salinity profiles ! (read from COORD_FILE) to set layer densities. ! USER - call a user modified routine. +REMAP_UV_USING_OLD_ALG = True ! [Boolean] default = False + ! If true, uses the old remapping-via-a-delta-z method for remapping u and v. If + ! false, uses the new method that remaps between grids described by an old and + ! new thickness. REGRIDDING_COORDINATE_MODE = "Z*" ! default = "LAYER" ! Coordinate mode for vertical regridding. Choose among the following ! possibilities: LAYER - Isopycnal or stacked shallow water layers @@ -137,6 +138,7 @@ REGRIDDING_COORDINATE_MODE = "Z*" ! default = "LAYER" ! SIGMA - terrain following coordinates ! RHO - continuous isopycnal ! HYCOM1 - HyCOM-like hybrid coordinate + ! HYBGEN - Hybrid coordinate from the Hycom hybgen code ! SLIGHT - stretched coordinates above continuous isopycnal ! ADAPTIVE - optimize for smooth neutral density surfaces !ALE_RESOLUTION = 2*50.0 ! [m] @@ -150,14 +152,14 @@ REMAPPING_SCHEME = "PPM_IH4" ! default = "PLM" ! variables. It can be one of the following schemes: PCM (1st-order ! accurate) ! PLM (2nd-order accurate) + ! PLM_HYBGEN (2nd-order accurate) ! PPM_H4 (3rd-order accurate) ! PPM_IH4 (3rd-order accurate) + ! PPM_HYBGEN (3rd-order accurate) + ! WENO_HYBGEN (3rd-order accurate) ! PQM_IH4IH3 (4th-order accurate) ! PQM_IH6IH5 (5th-order accurate) -! === module MOM_grid === -! Parameters providing information about the lateral grid. - ! === module MOM_state_initialization === INIT_LAYERS_FROM_Z_FILE = True ! [Boolean] default = False ! If true, initialize the layer thicknesses, temperatures, and salinities from a @@ -181,9 +183,9 @@ SPONGE_PTEMP_VAR = "ptemp" ! default = "PTEMP" ! The name of the potential temperature variable in SPONGE_STATE_FILE. SPONGE_SALT_VAR = "salt" ! default = "SALT" ! The name of the salinity variable in SPONGE_STATE_FILE. -NEW_SPONGES = True ! [of sponge restoring data.] default = False - ! Set True if using the newer sponging code which performs on-the-fly regridding - ! in lat-lon-time. +INTERPOLATE_SPONGE_TIME_SPACE = True ! [Boolean] default = False + ! If True, perform on-the-fly regridding in lat-lon-time of sponge restoring + ! data. ! === module MOM_sponge === SPONGE_DATA_ONGRID = True ! [Boolean] default = False @@ -192,8 +194,9 @@ SPONGE_DATA_ONGRID = True ! [Boolean] default = False ! The total number of columns where sponges are applied at h points. ! === module MOM_diag_mediator === - -! === module MOM_MEKE === +DIAG_AS_CHKSUM = True ! [Boolean] default = False + ! Instead of writing diagnostics to the diag manager, write a text file + ! containing the checksum (bitcount) of the array. ! === module MOM_lateral_mixing_coeffs === @@ -202,10 +205,10 @@ LINEAR_DRAG = True ! [Boolean] default = False ! If LINEAR_DRAG and BOTTOMDRAGLAW are defined the drag law is ! cdrag*DRAG_BG_VEL*u. HBBL = 10.0 ! [m] - ! The thickness of a bottom boundary layer with a viscosity of KVBBL if - ! BOTTOMDRAGLAW is not defined, or the thickness over which near-bottom - ! velocities are averaged for the drag law if BOTTOMDRAGLAW is defined but - ! LINEAR_DRAG is not. + ! The thickness of a bottom boundary layer with a viscosity increased by + ! KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which + ! near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is + ! defined but LINEAR_DRAG is not. CDRAG = 0.002 ! [nondim] default = 0.003 ! CDRAG is the drag coefficient relating the magnitude of the velocity field to ! the bottom stress. CDRAG is only used if BOTTOMDRAGLAW is defined. @@ -214,7 +217,7 @@ DRAG_BG_VEL = 0.05 ! [m s-1] default = 0.0 ! unresolved velocity that is combined with the resolved velocity to estimate ! the velocity magnitude. DRAG_BG_VEL is only used when BOTTOMDRAGLAW is ! defined. -BBL_USE_EOS = True ! [Boolean] default = False +BBL_USE_EOS = True ! [Boolean] default = True ! If true, use the equation of state in determining the properties of the bottom ! boundary layer. Otherwise use the layer target potential densities. BBL_THICK_MIN = 0.1 ! [m] default = 0.0 @@ -228,6 +231,13 @@ KV = 1.0E-04 ! [m2 s-1] ! === module MOM_thickness_diffuse === KHTH = 500.0 ! [m2 s-1] default = 0.0 ! The background horizontal thickness diffusivity. +USE_GM_WORK_BUG = True ! [Boolean] default = False + ! If true, compute the top-layer work tendency on the u-grid with the incorrect + ! sign, for legacy reproducibility. + +! === module MOM_porous_barriers === + +! === module MOM_dynamics_split_RK2 === BE = 0.7 ! [nondim] default = 0.6 ! If SPLIT is true, BE determines the relative weighting of a 2nd-order ! Runga-Kutta baroclinic time stepping scheme (0.5) and a backward Euler scheme @@ -258,7 +268,7 @@ BOUND_CORIOLIS = True ! [Boolean] default = False ! === module MOM_PressureForce === -! === module MOM_PressureForce_AFV === +! === module MOM_PressureForce_FV === RECONSTRUCT_FOR_PRESSURE = False ! [Boolean] default = True ! If True, use vertical reconstruction of T & S within the integrals of the FV ! pressure gradient calculation. If False, use the constant-by-layer algorithm. @@ -269,17 +279,25 @@ SMAGORINSKY_AH = True ! [Boolean] default = False ! If true, use a biharmonic Smagorinsky nonlinear eddy viscosity. SMAG_BI_CONST = 0.03 ! [nondim] default = 0.0 ! The nondimensional biharmonic Smagorinsky constant, typically 0.015 - 0.06. +USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = True + ! If true, use the land mask for the computation of thicknesses at velocity + ! locations. This eliminates the dependence on arbitrary values over land or + ! outside of the domain. ! === module MOM_vert_friction === DIRECT_STRESS = True ! [Boolean] default = False ! If true, the wind stress is distributed over the topmost HMIX_STRESS of fluid - ! (like in HYCOM), and KVML may be set to a very small value. + ! (like in HYCOM), and an added mixed layer viscosity or a physically based + ! boundary layer turbulence parameterization is not needed for stability. HMIX_FIXED = 20.0 ! [m] ! The prescribed depth over which the near-surface viscosity and diffusivity are ! elevated when the bulk mixed layer is not used. -KVML = 0.01 ! [m2 s-1] default = 1.0E-04 - ! The kinematic viscosity in the mixed layer. A typical value is ~1e-2 m2 s-1. - ! KVML is not used if BULKMIXEDLAYER is true. The default is set by KV. +KV_ML_INVZ2 = 0.01 ! [m2 s-1] default = 0.0 + ! An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, with + ! the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the distance + ! from the surface, to allow for finite wind stresses to be transmitted through + ! infinitesimally thin surface layers. This is an older option for numerical + ! convenience without a strong physical basis, and its use is now discouraged. MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 ! The maximum velocity allowed before the velocity components are truncated. @@ -304,23 +322,11 @@ DTBT = 10.0 ! [s or nondim] default = -0.98 ! DTBT to 0 is the same as setting it to -0.98. The value of DTBT that will ! actually be used is an integer fraction of DT, rounding down. -! === module MOM_mixed_layer_restrat === +! === module MOM_diagnostics === ! === module MOM_diabatic_driver === ! The following parameters are used for diabatic processes. -! === module MOM_CVMix_KPP === -! This is the MOM wrapper to CVMix:KPP -! See http://cvmix.github.io/ - -! === module MOM_tidal_mixing === -! Vertical Tidal Mixing Parameterization - -! === module MOM_CVMix_conv === -! Parameterization of enhanced mixing due to convection via CVMix - -! === module MOM_entrain_diffusive === - ! === module MOM_set_diffusivity === BBL_EFFIC = 0.0 ! [nondim] default = 0.2 ! The efficiency with which the energy extracted by bottom drag drives BBL @@ -332,29 +338,18 @@ KD = 0.0 ! [m2 s-1] ! The background diapycnal diffusivity of density in the interior. Zero or the ! molecular value, ~1e-7 m2 s-1, may be used. -! === module MOM_kappa_shear === -! Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008 - -! === module MOM_CVMix_shear === -! Parameterization of shear-driven turbulence via CVMix (various options) - -! === module MOM_CVMix_ddiff === -! Parameterization of mixing due to double diffusion processes via CVMix - ! === module MOM_diabatic_aux === ! The following parameters are used for auxiliary diabatic processes. -! === module MOM_regularize_layers === - ! === module MOM_opacity === +PEN_SW_ABSORB_MINTHICK = 0.001 ! [m] default = 1.0 + ! A thickness that is used to absorb the remaining penetrating shortwave heat + ! flux when it drops below PEN_SW_FLUX_ABSORB. ! === module MOM_tracer_advect === ! === module MOM_tracer_hor_diff === -! === module MOM_neutral_diffusion === -! This module implements neutral diffusion of tracers - ! === module MOM_sum_output === MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 ! The run will be stopped, and the day set to a very large value if the velocity @@ -362,6 +357,9 @@ MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 ! to stop if there is any truncation of velocities. DATE_STAMPED_STDOUT = False ! [Boolean] default = True ! If true, use dates (not times) in messages to stdout +ENERGYSAVEDAYS = 0.125 ! [days] default = 1.0 + ! The interval in units of TIMEUNIT between saves of the energies of the run and + ! other globally summed diagnostics. ! === module MOM_surface_forcing === VARIABLE_WINDS = False ! [Boolean] default = True @@ -375,19 +373,17 @@ BUOY_CONFIG = "zero" ! WIND_CONFIG = "zero" ! ! The character string that indicates how wind forcing is specified. Valid ! options include (file), (2gyre), (1gyre), (gyres), (zero), and (USER). - -! === module MOM_restart === +GUST_CONST = 0.02 ! [Pa] default = 0.0 + ! The background gustiness in the winds. +FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = True + ! If true correct a bug in the time-averaging of the gustless wind friction + ! velocity ! === module MOM_main (MOM_driver) === -DAYMAX = 0.25 ! [days] +DAYMAX = 0.25 ! [days] ! The final time of the whole simulation, in units of TIMEUNIT seconds. This ! also sets the potential end time of the present run segment if the end time is ! not set via ocean_solo_nml in input.nml. - -ENERGYSAVEDAYS = 0.125 ! [days] default = 1.44E+04 - ! The interval in units of TIMEUNIT between saves of the - ! energies of the run and other globally summed diagnostics. - RESTART_CONTROL = 3 ! default = 1 ! An integer whose bits encode which restart files are written. Add 2 (bit 1) ! for a time-stamped file, and odd (bit 0) for a non-time-stamped file. A @@ -405,21 +401,13 @@ MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 ! === module MOM_file_parser === -DIAG_AS_CHKSUM = True DEBUG = True -USE_PSURF_IN_EOS = False ! [Boolean] default = False -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True INTERPOLATE_RES_FN = True ! [Boolean] default = True GILL_EQUATORIAL_LD = False ! [Boolean] default = False -USE_GM_WORK_BUG = True ! [Boolean] default = True FIX_UNSPLIT_DT_VISC_BUG = False ! [Boolean] default = False -REMAP_UV_USING_OLD_ALG = True ! [Boolean] default = True USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False KAPPA_SHEAR_ITER_BUG = True ! [Boolean] default = True KAPPA_SHEAR_ALL_LAYER_TKE_BUG = True ! [Boolean] default = True USE_MLD_ITERATION = False ! [Boolean] default = False -PEN_SW_ABSORB_MINTHICK = 0.001 ! [m] default = 0.001 -GUST_CONST = 0.02 ! [Pa] default = 0.02 -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = False From a3ef1ac8ec12d2154b5eb5f0fb3f704e401f0f31 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 5 Jan 2023 09:03:55 -0500 Subject: [PATCH 133/213] +Obsoleted the runtime parameter NEW_SPONGES Formally obsoleted the runtime parameter NEW_SPONGES. The agreed upon replacement is INTERPOLATE_SPONGE_TIME_SPACE, which has been available for almost a year. There is a warning message rather than a fatal error if NEW_SPONGES is used and both are set consistently, and a hint if they are not. Also added or amended comments describing a number of the internal variables or their units in MOM_state_initialization. All answers and output are bitwise identical. --- src/diagnostics/MOM_obsolete_params.F90 | 5 +- .../MOM_state_initialization.F90 | 170 ++++++++---------- 2 files changed, 78 insertions(+), 97 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 19f3d87429..cea0c82bcf 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -95,8 +95,9 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") - ! This parameter is on the to-do list to be obsoleted. - ! call obsolete_logical(param_file, "NEW_SPONGES", hint="Use INTERPOLATE_SPONGE_TIME_SPACE instead.") + call read_param(param_file, "INTERPOLATE_SPONGE_TIME_SPACE", test_logic) + call obsolete_logical(param_file, "NEW_SPONGES", warning_val=test_logic, & + hint="Use INTERPOLATE_SPONGE_TIME_SPACE instead.") ! Write the file version number to the model log. call log_version(param_file, mdl, version) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0504994a30..49002d4846 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -154,9 +154,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. + ! a restart file to the internal representation in this run [various units ~> 1] real :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run. + ! a restart file to the internal representation in this run [various units ~> 1] real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. logical :: from_Z_file, useALE @@ -741,8 +741,8 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) endif call get_param(param_file, mdl, "DZ_BOTTOM_TOLERANCE", tol_dz_bot, & - "A tolerance for detecting inconsist topography and input layer "//& - "ticknesses when ADJUST_THICKNESS is false.", & + "A tolerance for detecting inconsistent topography and input layer "//& + "thicknesses when ADJUST_THICKNESS is false.", & units="m", default=1.0, scale=US%m_to_Z, & do_not_log=(just_read.or.correct_thickness)) call get_param(param_file, mdl, "INTERFACE_IC_VAR", eta_var, & @@ -1099,8 +1099,8 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read, z_top_shelf) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & eta ! The free surface height that the model should use [Z ~> m]. real :: dilate ! A ratio by which layers are dilated [nondim]. - real :: scale_factor ! A scaling factor for the eta_sfc values that are read - ! in, which can be used to change units, for example. + real :: scale_factor ! A scaling factor for the eta_sfc values that are read in, + ! which can be used to change units, for example, often [Z m-1 ~> 1]. character(len=40) :: mdl = "depress_surface" ! This subroutine's name. character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path @@ -1194,7 +1194,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T_t, T_b ! Top and bottom edge values for reconstructions ! of temperature within each layer [T ~> degC] character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path - real :: scale_factor ! A file-dependent scaling factor for the input pressure. + real :: scale_factor ! A file-dependent scaling factor for the input pressure [various]. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. real :: z_tolerance ! The tolerance with which to find the depth matching a specified pressure [Z ~> m]. integer :: i, j, k @@ -1305,7 +1305,7 @@ subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & eta ! The free surface height that the model should use [Z ~> m]. ! temporary arrays - real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice + real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice [R ~> kg m-3] real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2] real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] @@ -1401,10 +1401,12 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, !! values use more robust forms of the same remapping expressions. ! Local variables - real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions [Z ~> m] - real, dimension(nk) :: h0, S0, T0, h1, S1, T1 + real, dimension(nk+1) :: e ! Top and bottom edge positions for reconstructions [Z ~> m] + real, dimension(nk) :: h0, h1 ! Initial and remapped layer thicknesses [H ~> m or kg m-2] + real, dimension(nk) :: S0, S1 ! Initial and remapped layer salinities [S ~> ppt] + real, dimension(nk) :: T0, T1 ! Initial and remapped layer temperatures [C ~> degC] real :: P_t, P_b ! Top and bottom pressures [R L2 T-2 ~> Pa] - real :: z_out, e_top + real :: z_out, e_top ! Interface height positions [Z ~> m] logical :: answers_2018 integer :: k @@ -1568,7 +1570,7 @@ subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read) !! parameters without changing u or v. ! Local variables integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real :: initial_u_const, initial_v_const + real :: initial_u_const, initial_v_const ! Constant initial velocities [L T-1 ~> m s-1] character(len=200) :: mdl = "initialize_velocity_uniform" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1609,7 +1611,7 @@ subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read) ! Local variables character(len=200) :: mdl = "initialize_velocity_circular" real :: circular_max_u ! The amplitude of the zonal flow [L T-1 ~> m s-1] - real :: dpi ! A local variable storing pi = 3.14159265358979... + real :: dpi ! A local variable storing pi = 3.14159265358979... [nondim] real :: psi1, psi2 ! Values of the streamfunction at two points [L2 T-1 ~> m2 s-1] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1722,7 +1724,8 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, US, param_file, just_r logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T or S. ! Local variables - real, dimension(SZK_(GV)) :: T0, S0 + real, dimension(SZK_(GV)) :: T0 ! The profile of temperatures [C ~> degC] + real, dimension(SZK_(GV)) :: S0 ! The profile of salinities [S ~> ppt] integer :: i, j, k character(len=200) :: filename, ts_file, inputdir ! Strings for file/path character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files @@ -1866,12 +1869,11 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, US, param_file, just_read) !! this call will only read parameters !! without changing T or S. - integer :: k - real :: S_top, T_top ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer - real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical - !real :: delta_S, delta_T - !real :: delta + ! Local variables + real :: S_top, S_range ! Reference salinity in the surface layer and its vertical range [S ~> ppt] + real :: T_top, T_range ! Reference temperature in the surface layer and its vertical range [C ~> degC] character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's name. + integer :: k if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_TOP", T_top, & @@ -1889,25 +1891,18 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, US, param_file, just_read) if (just_read) return ! All run-time parameters have been read, so return. - ! Prescribe salinity - !delta_S = S_range / ( GV%ke - 1.0 ) - !S(:,:,1) = S_top - !do k=2,GV%ke - ! S(:,:,k) = S(:,:,k-1) + delta_S - !enddo + ! Prescribe salinity and temperature, with the extrapolated top interface value prescribed. do k=1,GV%ke S(:,:,k) = S_top - S_range*((real(k)-0.5)/real(GV%ke)) T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(GV%ke)) enddo - ! Prescribe temperature - !delta_T = T_range / ( GV%ke - 1.0 ) - !T(:,:,1) = T_top - !do k=2,GV%ke - ! T(:,:,k) = T(:,:,k-1) + delta_T - !enddo - !delta = 1 - !T(:,:,GV%ke/2 - (delta-1):GV%ke/2 + delta) = 1.0 + ! Prescribe salinity and temperature, but with the top layer value matching the surface value. + ! S(:,:,1) = S_top ; T(:,:,1) = T_top + ! do k=2,GV%ke + ! S(:,:,k) = S_top - S_range * (real(k-1) / real(GV%ke-1)) + ! T(:,:,k) = T_top - T_range * (real(k-1) / real(GV%ke-1)) + ! enddo call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_linear @@ -1945,11 +1940,17 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses [H ~> m or kg m-2]. real, dimension (SZI_(G),SZJ_(G),SZK_(GV)) :: & - tmp, tmp2 ! A temporary array for tracers. + tmp, & ! A temporary array for temperatures [C ~> degC] or other tracers. + tmp2 ! A temporary array for salinities [S ~> ppt] real, dimension (SZI_(G),SZJ_(G)) :: & - tmp_2d ! A temporary array for tracers. - real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge fields - real, allocatable, dimension(:,:,:) :: tmp_u,tmp_v ! A temporary array for reading sponge fields + tmp_2d ! A temporary array for mixed layer densities [R ~> kg m-3] + real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge target fields + ! on the vertical grid of the input file, used for both + ! temperatures [C ~> degC] and salinities [S ~> ppt] + real, allocatable, dimension(:,:,:) :: tmp_u ! Temporary array for reading sponge target zonal + ! velocities on the vertical grid of the input file [L T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: tmp_v ! Temporary array for reading sponge target meridional + ! velocities on the vertical grid of the input file [L T-1 ~> m s-1] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: Idamp_u(SZIB_(G),SZJ_(G)) ! The sponge damping rate for velocity fields [T-1 ~> s-1] @@ -1968,7 +1969,6 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t character(len=200) :: filename, inputdir ! Strings for file/path and path. logical :: use_ALE ! True if ALE is being used, False if in layered mode - logical :: new_sponge_param ! The value of a deprecated parameter. logical :: time_space_interp_sponge ! If true use sponge data that need to be interpolated in both ! the horizontal dimension and in time prior to vertical remapping. @@ -2024,34 +2024,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t endif call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, default=.false., do_not_log=.true.) - !### NEW_SPONGES should be obsoleted properly, rather than merely deprecated, at which - ! point only the else branch of the new_sponge_param block would be retained. - call get_param(param_file, mdl, "NEW_SPONGES", new_sponge_param, & - "Set True if using the newer sponging code which "//& - "performs on-the-fly regridding in lat-lon-time"//& - "of sponge restoring data.", default=.false., do_not_log=.true.) - if (new_sponge_param) then - call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & - "If True, perform on-the-fly regridding in lat-lon-time of sponge restoring data.", & - default=.true., do_not_log=.true.) - if (.not.time_space_interp_sponge) then - call MOM_error(FATAL, " initialize_sponges: NEW_SPONGES has been deprecated, "//& - "but is set to true inconsistently with INTERPOLATE_SPONGE_TIME_SPACE. "//& - "Remove the NEW_SPONGES input line.") - else - call MOM_error(WARNING, " initialize_sponges: NEW_SPONGES has been deprecated. "//& - "Please use INTERPOLATE_SPONGE_TIME_SPACE instead. Setting "//& - "INTERPOLATE_SPONGE_TIME_SPACE = True.") - endif - call log_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & - "If True, perform on-the-fly regridding in lat-lon-time of sponge restoring data.", & - default=.true.) - else - call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & + call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & "If True, perform on-the-fly regridding in lat-lon-time of sponge restoring data.", & default=.false.) - endif - ! Read in sponge damping rate for tracers filename = trim(inputdir)//trim(damping_file) @@ -2143,8 +2118,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t if ( use_temperature) then call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain, scale=US%degC_to_C) call set_up_sponge_field(tmp, tv%T, G, GV, nz, Layer_CSp) - call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain, scale=US%ppt_to_S) - call set_up_sponge_field(tmp, tv%S, G, GV, nz, Layer_CSp) + call MOM_read_data(filename, salin_var, tmp2(:,:,:), G%Domain, scale=US%ppt_to_S) + call set_up_sponge_field(tmp2, tv%S, G, GV, nz, Layer_CSp) endif ! else @@ -2247,30 +2222,34 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p oda_incupd_CSp, restart_CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_temperature !< If true, T & S are state variables. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic - !! variables. + !! variables. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] (in) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u !< The zonal velocity that is being + intent(in) :: u !< The zonal velocity that is being !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< The meridional velocity that is being - !! initialized [L T-1 ~> m s-1] + intent(in) :: v !< The meridional velocity that is being + !! initialized [L T-1 ~> m s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(oda_incupd_CS), pointer :: oda_incupd_CSp !< A pointer that is set to point to the control - !! structure for this module. + !! structure for this module. type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure - type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in - !! overrides any value set for - !Time. + type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in + !! overrides any value set for Time. ! Local variables - real, allocatable, dimension(:,:,:) :: hoda ! The layer thk inc. and oda layer thk [H ~> m or kg m-2]. - real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading oda fields - real, allocatable, dimension(:,:,:) :: tmp_u, tmp_v ! Temporary arrays for reading oda fields + real, allocatable, dimension(:,:,:) :: hoda ! The layer thickness increment and oda layer thickness [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading oda tracer increments + ! on the vertical grid of the input file, used for both + ! temperatures [C ~> degC] and salinities [S ~> ppt] + real, allocatable, dimension(:,:,:) :: tmp_u ! Temporary array for reading oda zonal velocity + ! increments on the vertical grid of the input file [L T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: tmp_v ! Temporary array for reading oda meridional velocity + ! increments on the vertical grid of the input file [L T-1 ~> m s-1] integer :: is, ie, js, je, nz integer :: isd, ied, jsd, jed @@ -2375,7 +2354,7 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p allocate(tmp_v(isd:ied,G%JsdB:G%JedB,nz_data), source=0.0) call MOM_read_vector(filename, uinc_var, vinc_var, tmp_u, tmp_v, G%Domain,scale=US%m_s_to_L_T) call set_up_oda_incupd_vel_field(tmp_u, tmp_v, G, GV, oda_incupd_CSp) - deallocate(tmp_u,tmp_v) + deallocate(tmp_u, tmp_v) endif ! calculate increments if input are full fields @@ -2415,8 +2394,8 @@ subroutine compute_global_grid_integrals(G, US) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming - real :: area_scale + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming ! Masked and unscaled areas for sums [m2] + real :: area_scale ! A conversion factor to prepare for reproducing sums [m2 L-2 ~> 1] integer :: i,j area_scale = US%L_to_m**2 @@ -2536,7 +2515,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real, dimension(:,:,:), allocatable, target :: tmpS1dIn ! Input salinities on a model-sized grid [S ~> ppt] real, dimension(:,:,:), allocatable :: tmp_mask_in ! The valid data mask on a model-sized grid [nondim] real, dimension(:,:,:), allocatable :: h1 ! Thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding + real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to + ! regridding [H ~> m or kg m-2] real :: zTopOfCell, zBottomOfCell ! Heights in Z units [Z ~> m]. type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays @@ -2685,8 +2665,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just units="m", default=0.1, scale=US%m_to_Z, & do_not_log=(just_read.or..not.correct_thickness)) call get_param(PF, mdl, "DZ_BOTTOM_TOLERANCE", tol_dz_bot, & - "A tolerance for detecting inconsist topography and input layer "//& - "ticknesses when ADJUST_THICKNESS is false.", & + "A tolerance for detecting inconsistent topography and input layer "//& + "thicknesses when ADJUST_THICKNESS is false.", & units="m", default=1.0, scale=US%m_to_Z, & do_not_log=(just_read.or.correct_thickness)) @@ -2727,12 +2707,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just units="1e-3", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(PF, mdl, "HORIZ_INTERP_TOL_TEMP", tol_temp, & "The tolerance in temperature changes between iterations when interpolating "//& - "ifrom an nput dataset using horiz_interp_and_extrap_tracer. This routine "//& + "from an input dataset using horiz_interp_and_extrap_tracer. This routine "//& "converges slowly, so an overly small tolerance can get expensive.", & units="degC", default=1.0e-3, scale=US%degC_to_C, do_not_log=just_read) call get_param(PF, mdl, "HORIZ_INTERP_TOL_SALIN", tol_sal, & "The tolerance in salinity changes between iterations when interpolating "//& - "ifrom an nput dataset using horiz_interp_and_extrap_tracer. This routine "//& + "from an input dataset using horiz_interp_and_extrap_tracer. This routine "//& "converges slowly, so an overly small tolerance can get expensive.", & units="1e-3", default=1.0e-3, scale=US%ppt_to_S, do_not_log=just_read) @@ -2796,11 +2776,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just allocate( tmpT1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) allocate( tmpS1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) do j = js, je ; do i = is, ie - if (G%mask2dT(i,j)>0.) then + if (G%mask2dT(i,j) > 0.) then zTopOfCell = 0. ; zBottomOfCell = 0. tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd - if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then + if ((tmp_mask_in(i,j,k) > 0.) .and. (k <= kd)) then zBottomOfCell = max( z_edges_in(k+1), Z_bottom(i,j)) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) @@ -2831,7 +2811,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just hTarget = getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie h(i,j,:) = 0. - if (G%mask2dT(i,j)>0.) then + if (G%mask2dT(i,j) > 0.) then ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz @@ -3013,7 +2993,7 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n real, dimension(SZK_(GV)+1) :: zi_ ! A column interface heights (negative downward) [Z ~> m]. real :: slope ! The rate of change of height with density [Z R-1 ~> m4 kg-1] real :: drhodz ! A local vertical density gradient [R Z-1 ~> kg m-4] - real, parameter :: zoff=0.999 + real, parameter :: zoff = 0.999 ! A small fractional adjustment to the density differences [nondim] logical :: unstable ! True if the column is statically unstable anywhere. integer :: nlevs_data ! The number of data values in a column. logical :: work_down ! This indicates whether this pass goes up or down the water column. @@ -3028,18 +3008,18 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n nlevs_data = nlevs(i,j) do k=1,nlevs_data ; rho_(k) = rho(i,j,k) ; enddo - unstable=.true. + unstable = .true. work_down = .true. do while (unstable) ! Modify the input profile until it no longer has densities that decrease with depth. - unstable=.false. + unstable = .false. if (work_down) then - do k=2,nlevs_data-1 ; if (rho_(k) - rho_(k-1) < 0.0 ) then + do k=2,nlevs_data-1 ; if (rho_(k) - rho_(k-1) < 0.0) then if (k == 2) then rho_(k-1) = rho_(k) - eps_rho else drhodz = (rho_(k+1)-rho_(k-1)) / (zin(k+1)-zin(k-1)) - if (drhodz < 0.0) unstable=.true. + if (drhodz < 0.0) unstable = .true. rho_(k) = rho_(k-1) + drhodz*zoff*(zin(k)-zin(k-1)) endif endif ; enddo @@ -3054,7 +3034,7 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n endif else drhodz = (rho_(k+1)-rho_(k-1)) / (zin(k+1)-zin(k-1)) - if (drhodz < 0.0) unstable=.true. + if (drhodz < 0.0) unstable = .true. rho_(k) = rho_(k+1) - drhodz*(zin(k+1)-zin(k)) endif endif ; enddo From 3f82a92bbe682a6d7dfafbf2d2de822940843389 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 5 Jan 2023 11:29:33 -0500 Subject: [PATCH 134/213] Updated comments in MOM_initialize_topography Updated the comments in MOM_initialize_topography to reflect the fact that US is no longer an optional argument. Only comments are changed, and all answers are bitwise identical. --- src/initialization/MOM_fixed_initialization.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 16702b6901..0cc3794543 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -174,14 +174,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed -!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this -!! point the topography is in units of [Z ~> m] or [m], depending on the presence of US. +!> MOM_initialize_topography makes the appropriate call to set up the bathymetry in units of [Z ~> m]. subroutine MOM_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [Z ~> m] or [m] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] or [m] + real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. From 4be437a0bbc44111fed7ae7fcde8635bddc1e9d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 5 Jan 2023 11:31:16 -0500 Subject: [PATCH 135/213] Added units to comments in MOM_grid_initialization Added a description of the units to the comments for each of the real variables in MOM_grid_initialization and MOM_shared_initialization. Only comments are changed, and all answers are bitwise identical. --- src/initialization/MOM_grid_initialize.F90 | 139 ++++++++++-------- .../MOM_shared_initialization.F90 | 2 +- 2 files changed, 75 insertions(+), 66 deletions(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 964007c663..e622b11805 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -177,7 +177,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpU ! East face supergrid spacing [L ~> m] real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV ! North face supergrid spacing [L ~> m] real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ ! Corner latitudes or longitudes [degN] or [degE] - real, dimension(:,:), allocatable :: tmpGlbl ! A global array of axis labels + real, dimension(:,:), allocatable :: tmpGlbl ! A global array of axis labels [degrees_N] or [km] or [m] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -361,8 +361,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal - real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) - real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) + real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) ! Axis labels [degrees_N] or [km] or [m] + real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) ! Axis labels [degrees_E] or [km] or [m] real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. real :: PI @@ -498,13 +498,17 @@ subroutine set_grid_metrics_spherical(G, param_file, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) + real :: PI ! PI = 3.1415926... as 4*atan(1) [nondim] + real :: PI_180 ! The conversion factor from degrees to radians [radians degree-1] integer :: i, j, isd, ied, jsd, jed integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB integer :: i_offset, j_offset - real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) - real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dLon, dLat, latitude, dL_di + real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) ! Axis labels [degrees_N] + real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) ! Axis labels [degrees_E] + real :: dLon ! The change in longitude between successive grid points [degrees_E] + real :: dLat ! The change in latitude between successive grid points [degrees_N] + real :: dL_di ! dLon rescaled from degrees to radians [radians] + real :: latitude ! The latitude of a grid point [degrees_N] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -517,7 +521,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! Calculate the values of the metric terms that might be used ! and save them in arrays. - PI = 4.0*atan(1.0); PI_180 = atan(1.0)/45. + PI = 4.0*atan(1.0) ; PI_180 = atan(1.0)/45. call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & "The southern latitude of the domain.", units="degrees_N", & @@ -639,19 +643,23 @@ subroutine set_grid_metrics_mercator(G, param_file, US) integer :: I_off, J_off type(GPS) :: GP character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_mercator" - real :: PI, PI_2! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0 - real :: y_q, y_h, jd, x_q, x_h, id + real :: PI, PI_2 ! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0 [nondim] + real :: y_q, y_h ! Latitudes of a point [radians] + real :: id ! The i-grid space positions whose longitude is being sought [gridpoints] + real :: jd ! The j-grid space positions whose latitude is being sought [gridpoints] + real :: x_q, x_h ! Longitudes of a point [radians] real, dimension(G%isd:G%ied,G%jsd:G%jed) :: & - xh, yh ! Latitude and longitude of h points in radians. + xh, yh ! Latitude and longitude of h points in radians [radians] real, dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: & - xu, yu ! Latitude and longitude of u points in radians. + xu, yu ! Latitude and longitude of u points in radians [radians] real, dimension(G%isd:G%ied,G%JsdB:G%JedB) :: & - xv, yv ! Latitude and longitude of v points in radians. + xv, yv ! Latitude and longitude of v points in radians [radians] real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - xq, yq ! Latitude and longitude of q points in radians. + xq, yq ! Latitude and longitude of q points in radians [radians] real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is - real :: jRef, iRef ! being set to be at grid index jRef or iRef. + ! being set to be at grid index jRef or iRef [gridpoints] + real :: jRef, iRef ! The grid index at which fnRef is evaluated [gridpoints] integer :: itt1, itt2 logical, parameter :: simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -860,8 +868,8 @@ end subroutine set_grid_metrics_mercator !> This function returns the grid spacing in the logical x direction in [L ~> m]. function ds_di(x, y, GP) - real, intent(in) :: x !< The longitude in question - real, intent(in) :: y !< The latitude in question + real, intent(in) :: x !< The longitude in question [radians] + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_di ! The returned grid spacing [L ~> m] @@ -874,8 +882,8 @@ end function ds_di !> This function returns the grid spacing in the logical y direction in [L ~> m]. function ds_dj(x, y, GP) - real, intent(in) :: x !< The longitude in question - real, intent(in) :: y !< The latitude in question + real, intent(in) :: x !< The longitude in question [radians] + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_dj ! The returned grid spacing [L ~> m] @@ -887,16 +895,17 @@ function ds_dj(x, y, GP) end function ds_dj !> This function returns the contribution from the line integral along one of the four sides of a -!! cell face to the area of a cell, assuming that the sides follow a linear path in latitude and -!! longitude (i.e., on a Mercator grid). +!! cell face to the area of a cell, in [radians2], assuming that the sides follow a linear path in +!! latitude and longitude (i.e., on a Mercator grid). function dL(x1, x2, y1, y2) - real, intent(in) :: x1 !< Segment starting longitude, in degrees E. - real, intent(in) :: x2 !< Segment ending longitude, in degrees E. - real, intent(in) :: y1 !< Segment ending latitude, in degrees N. - real, intent(in) :: y2 !< Segment ending latitude, in degrees N. + real, intent(in) :: x1 !< Segment starting longitude [radians] + real, intent(in) :: x2 !< Segment ending longitude [radians] + real, intent(in) :: y1 !< Segment starting latitude [radians] + real, intent(in) :: y2 !< Segment ending latitude [radians] ! Local variables - real :: dL - real :: r, dy + real :: dL ! A contribution to the spanned area the surface of the sphere [radian2] + real :: r ! A contribution from the range of latitudes, including trigonometric factors [radians] + real :: dy ! The spanned range of latitudes [radians] dy = y2 - y1 @@ -914,22 +923,24 @@ end function dL !! Newton's method that were used to polish the root. function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) real :: find_root !< The value of y where fn(y) = fnval that will be returned - real, external :: fn !< The external function whose root is being sought - real, external :: dy_df !< The inverse of the derivative of that function - type(GPS), intent(in) :: GP !< A structure of grid parameters - real, intent(in) :: fnval !< The value of fn being sought - real, intent(in) :: y1 !< A first guess for y - real, intent(in) :: ymin !< The minimum permitted value of y - real, intent(in) :: ymax !< The maximum permitted value of y + real, external :: fn !< The external function whose root is being sought [gridpoints] + real, external :: dy_df !< The inverse of the derivative of that function [radian gridpoint-1] + type(GPS), intent(in) :: GP !< A structure of grid parameters + real, intent(in) :: fnval !< The value of fn being sought [gridpoints] + real, intent(in) :: y1 !< A first guess for y [radians] + real, intent(in) :: ymin !< The minimum permitted value of y [radians] + real, intent(in) :: ymax !< The maximum permitted value of y [radians] integer, intent(out) :: ittmax !< The number of iterations used to polish the root ! Local variables - real :: y, y_next - real :: ybot, ytop, fnbot, fntop + real :: y, y_next ! Successive guesses at the root position [radians] + real :: ybot, ytop ! Brackets bounding the root [radians] + real :: fnbot, fntop ! Values of fn at the bounding values of y [gridpoints] + real :: dy_dfn ! The inverse of the local derivative of fn with y [radian gridpoint-1] + real :: dy ! The jump to the next guess of y [radians] + real :: fny ! The difference between fn(y) and the target value [gridpoints] integer :: itt character(len=256) :: warnmesg - real :: dy_dfn, dy, fny - ! Bracket the root. Do not use the bounding values because the value at the ! function at the bounds could be infinite, as is the case for the Mercator ! grid recursion relation. (I.e., this is a search on an open interval.) @@ -1022,40 +1033,40 @@ function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) find_root = y end function find_root -!> This function calculates and returns the value of dx/di, where x is the -!! longitude in Radians, and i is the integral north-south grid index. +!> This function calculates and returns the value of dx/di in [radian gridpoint-1], +!! where x is the longitude in Radians, and i is the integral east-west grid index. function dx_di(x, GP) - real, intent(in) :: x !< The longitude in question + real, intent(in) :: x !< The longitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: dx_di + real :: dx_di ! The derivative of zonal position with the grid index [radian gridpoint-1] dx_di = (GP%len_lon * 4.0*atan(1.0)) / (180.0 * GP%niglobal) end function dx_di !> This function calculates and returns the integral of the inverse -!! of dx/di to the point x, in radians. +!! of dx/di to the point x, in radians [gridpoints] function Int_di_dx(x, GP) - real, intent(in) :: x !< The longitude in question + real, intent(in) :: x !< The longitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: Int_di_dx + real :: Int_di_dx ! A position in the global i-index space [gridpoints] Int_di_dx = x * ((180.0 * GP%niglobal) / (GP%len_lon * 4.0*atan(1.0))) end function Int_di_dx -!> This subroutine calculates and returns the value of dy/dj, where y is the -!! latitude in Radians, and j is the integral north-south grid index. +!> This subroutine calculates and returns the value of dy/dj in [radian gridpoint-1], +!! where y is the latitude in Radians, and j is the integral north-south grid index. function dy_dj(y, GP) - real, intent(in) :: y !< The latitude in question + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: dy_dj + real :: dy_dj ! The derivative of meridional position with the grid index [radian gridpoint-1] ! Local variables - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: C0 ! The constant that converts the nominal y-spacing in - ! gridpoints to the nominal spacing in Radians. + ! gridpoints to the nominal spacing in Radians [radian gridpoint-1] real :: y_eq_enhance ! The latitude in radians within which the resolution - ! is enhanced. + ! is enhanced [radians] PI = 4.0*atan(1.0) if (GP%isotropic) then C0 = (GP%len_lon * PI) / (180.0 * GP%niglobal) @@ -1074,21 +1085,19 @@ function dy_dj(y, GP) end function dy_dj !> This subroutine calculates and returns the integral of the inverse -!! of dy/dj to the point y, in radians. +!! of dy/dj to the point y in radians [gridpoints] function Int_dj_dy(y, GP) - real, intent(in) :: y !< The latitude in question + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: Int_dj_dy + real :: Int_dj_dy ! The grid position of latitude y [gridpoints] ! Local variables - real :: I_C0 = 0.0 ! The inverse of the constant that converts the + real :: I_C0 ! The inverse of the constant that converts the ! nominal spacing in gridpoints to the nominal - ! spacing in Radians. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: y_eq_enhance ! The latitude in radians from - ! from the equator within which the - ! meridional grid spacing is enhanced by - ! a factor of GP%lat_enhance_factor. - real :: r + ! spacing in Radians [gridpoint radian-1] + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] + real :: y_eq_enhance ! The latitude in radians from from the equator within which the meridional + ! grid spacing is enhanced by a factor of GP%lat_enhance_factor [radians] + real :: r ! The y grid position in the global index space [gridpoints] PI = 4.0*atan(1.0) if (GP%isotropic) then @@ -1119,9 +1128,9 @@ end function Int_dj_dy !> Extrapolates missing metric data into all the halo regions. subroutine extrapolate_metric(var, jh, missing) - real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos + real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos [A] integer, intent(in) :: jh !< The size of the halos to be filled - real, optional, intent(in) :: missing !< The missing data fill value, 0 by default. + real, optional, intent(in) :: missing !< The missing data fill value, 0 by default [A] ! Local variables real :: badval integer :: i,j diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 73be3f5843..acffc9c927 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1309,7 +1309,7 @@ subroutine compute_global_grid_integrals(G, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming ! Masked and unscaled cell areas [m2] real :: area_scale ! A scaling factor for area into MKS units [m2 L-2 ~> 1] integer :: i,j From 297cc89cbee4090fc8035023101747e4e3864ebb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jan 2023 05:21:04 -0500 Subject: [PATCH 136/213] Document units of variables in MOM_wave_speed Added or amended comments to document the units of numerous internal variables and function arguments in MOM_wave_speed.F90. Only comments are changed, but the position of some variable declarations is changed to help the comments make more sense. All answers are bitwise identical and no output is changed. --- src/diagnostics/MOM_wave_speed.F90 | 129 ++++++++++++++++++----------- 1 file changed, 81 insertions(+), 48 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 36dc884679..3dcad440ce 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -35,7 +35,7 @@ module MOM_wave_speed !! internal wave speed. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as !! monotonic for the purposes of calculating the equivalent barotropic - !! wave speed. This parameter controls the default behavior of + !! wave speed [nondim]. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed [Z ~> m]. @@ -72,7 +72,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction !! of water column over which N2 is limited as monotonic - !! for the purposes of calculating vertical modal structure. + !! for the purposes of calculating vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical !! modal structure [Z ~> m]. @@ -104,11 +104,14 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] - real :: det, ddet + real :: det, ddet ! Determinant of the eigen system and its derivative with lam. Because the + ! units of the eigenvalue change with the number of layers and because of the + ! dynamic rescaling that is used to keep det in a numerically representable range, + ! the units of of det are hard to interpret, but det/ddet is always in units + ! of [T2 L-2 ~> s2 m-2] real :: lam ! The eigenvalue [T2 L-2 ~> s2 m-2] real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s2 m-2] - real :: min_h_frac ! [nondim] real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m] @@ -122,29 +125,40 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 L-2 ~> 1]. real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. - real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant - ! and its derivative with lam between rows of the Thomas algorithm solver. The - ! exact value should not matter for the final result if it is an even power of 2. + real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and + ! its derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. + ! The exact value should not matter for the final result if it is an even power of 2. real :: tol_Hfrac ! Layers that together are smaller than this fraction of - ! the total water column can be merged for efficiency. + ! the total water column can be merged for efficiency [nondim]. + real :: min_h_frac ! tol_Hfrac divided by the total number of layers [nondim]. real :: tol_solve ! The fractional tolerance with which to solve for the wave speeds [nondim] real :: tol_merge ! The fractional change in estimated wave speed that is allowed ! when deciding to merge layers in the calculation [nondim] - real :: rescale, I_rescale + real :: rescale ! A rescaling factor to control the magnitude of the determinant [nondim] + real :: I_rescale ! The reciprocal of the rescaling factor to control the magnitude of the determinant [nondim] integer :: kf(SZI_(G)) ! The number of active layers after filtering. integer, parameter :: max_itt = 10 - real :: lam_it(max_itt), det_it(max_itt), ddet_it(max_itt) + real :: lam_it(max_itt) ! The guess at the eignevalue with each iteration [T2 L-2 ~> s2 m-2] + real :: det_it(max_itt), ddet_it(max_itt) ! The determinant of the matrix and its derivative with lam + ! with each iteration. Because of all of the dynamic rescaling of the determinant + ! between rows, its units are not easily interpretable, but the ratio of det/ddet + ! always has units of [T2 L-2 ~> s2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. logical :: better_est ! If true, use an improved estimate of the first mode internal wave speed. logical :: merge ! If true, merge the current layer with the one above. integer :: kc ! The number of layers in the column after merging integer :: i, j, k, k2, itt, is, ie, js, je, nz - real :: hw, sum_hc + real :: hw ! The mean of the adjacent layer thicknesses [Z ~> m] + real :: sum_hc ! The sum of the layer thicknesses [Z ~> m] real :: gp ! A limited local copy of gprime [L2 Z-1 T-2 ~> m s-2] real :: N2min ! A minimum buoyancy frequency [T-2 ~> s-2] logical :: l_use_ebt_mode, calc_modal_structure - real :: l_mono_N2_column_fraction, l_mono_N2_depth - real :: mode_struct(SZK_(GV)), ms_min, ms_max, ms_sq + real :: l_mono_N2_column_fraction ! A local value of mono_N2_column_fraction [nondim] + real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [Z ~> m] + real :: mode_struct(SZK_(GV)) ! The mode structure [nondim], but it is also temporarily + ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6. + real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2] + real :: ms_sq ! The sum of the square of the values returned from tdma6 [L4 T-4 ~> m4 s-4] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -525,6 +539,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ if (calc_modal_structure) then call tdma6(kc, Igu, Igl, lam, mode_struct) + ! Note that tdma6 changes the units of mode_struct to [L2 T-2 ~> m2 s-2] ms_min = mode_struct(1) ms_max = mode_struct(1) ms_sq = mode_struct(1)**2 @@ -540,6 +555,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ else mode_struct(1:kc) = mode_struct(1:kc) / sqrt( ms_sq ) endif + ! After the nondimensionalization above, mode_struct is once again [nondim] endif if (abs(dlam) < tol_solve*lam) exit @@ -590,13 +606,13 @@ subroutine tdma6(n, a, c, lam, y) real, dimension(:), intent(in) :: a !< Lower diagonal [T2 L-2 ~> s2 m-2] real, dimension(:), intent(in) :: c !< Upper diagonal [T2 L-2 ~> s2 m-2] real, intent(in) :: lam !< Scalar subtracted from leading diagonal [T2 L-2 ~> s2 m-2] - real, dimension(:), intent(inout) :: y !< RHS on entry, result on exit + real, dimension(:), intent(inout) :: y !< RHS on entry [A ~> a], result on exit [A L2 T-2 ~> a m2 s-2] ! Local variables real :: lambda ! A temporary variable in [T2 L-2 ~> s2 m-2] real :: beta(n) ! A temporary variable in [T2 L-2 ~> s2 m-2] real :: I_beta(n) ! A temporary variable in [L2 T-2 ~> m2 s-2] - real :: yy(n) ! A temporary variable with the same units as y on entry. + real :: yy(n) ! A temporary variable with the same units as y on entry [A ~> a] integer :: k, m lambda = lam @@ -634,16 +650,16 @@ end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] type(wave_speed_CS), optional, intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational domain. + !! over the entire data domain. ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -670,23 +686,34 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] real :: c1_thresh ! if c1 is below this value, don't bother calculating ! cn values for higher modes [L T-1 ~> m s-1] - real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant - ! and its derivative with lam between rows of the Thomas algorithm solver. The - ! exact value should not matter for the final result if it is an even power of 2. - real :: det, ddet ! determinant & its derivative of eigen system + real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and its + ! derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. + ! The exact value should not matter for the final result if it is an even power of 2. + real :: det, ddet ! Determinant of the eigen system and its derivative with lam. Because the + ! units of the eigenvalue change with the number of layers and because of the + ! dynamic rescaling that is used to keep det in a numerically representable range, + ! the units of of det are hard to interpret, but det/ddet is always in units + ! of [T2 L-2 ~> s2 m-2] real :: lam_1 ! approximate mode-1 eigenvalue [T2 L-2 ~> s2 m-2] real :: lam_n ! approximate mode-n eigenvalue [T2 L-2 ~> s2 m-2] real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] real :: lamMin ! minimum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamMax ! maximum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamInc ! width of moving window for root searching [T2 L-2 ~> s2 m-2] - real :: det_l,det_r ! determinant value at left and right of window - real :: ddet_l,ddet_r ! derivative of determinant at left and right of window - real :: det_sub,ddet_sub! derivative of determinant at subinterval endpoint - real :: xl,xr ! lam guesses at left and right of window [T2 L-2 ~> s2 m-2] + real :: det_l, ddet_l ! determinant of the eigensystem and its derivative with lam at the lower + ! end of the range of values bracketing a particular root, in dynamically + ! rescaled units that may differ from the other det variables, but such + ! that the units of det_l/ddet_l are [T2 L-2 ~> s2 m-2] + real :: det_r, ddet_r ! determinant and its derivative with lam at the lower end of the + ! bracket in arbitrarily rescaled units, but such that the units of + ! det_r/ddet_r are [T2 L-2 ~> s2 m-2] + real :: det_sub, ddet_sub ! determinant and its derivative with lam at a subinterval endpoint that + ! is a candidate for a new bracket endpoint in arbitrarily rescaled units, + ! but such that the units of det_sub/ddet_sub are [T2 L-2 ~> s2 m-2] + real :: xl, xr ! lam guesses at left and right of window [T2 L-2 ~> s2 m-2] real :: xl_sub ! lam guess at left of subinterval window [T2 L-2 ~> s2 m-2] - real,dimension(nmodes) :: & - xbl,xbr ! lam guesses bracketing a zero-crossing (root) [T2 L-2 ~> s2 m-2] + real, dimension(nmodes) :: & + xbl, xbr ! lam guesses bracketing a zero-crossing (root) [T2 L-2 ~> s2 m-2] integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] @@ -698,14 +725,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) HxR_here ! A layer integrated density [R Z ~> kg m-2] real :: speed2_tot ! overestimate of the mode-1 speed squared [L2 T-2 ~> m2 s-2] real :: speed2_min ! minimum mode speed (squared) to consider in root searching [L2 T-2 ~> m2 s-2] - real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] - real, parameter :: reduct_factor = 0.5 - ! A factor used in setting speed2_min [nondim] - real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] - real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. + real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] + real, parameter :: reduct_factor = 0.5 ! A factor used in setting speed2_min [nondim] + real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] + real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] + real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: tol_Hfrac ! Layers that together are smaller than this fraction of - ! the total water column can be merged for efficiency. + ! the total water column can be merged for efficiency [nondim]. real :: min_h_frac ! tol_Hfrac divided by the total number of layers [nondim]. real :: tol_solve ! The fractional tolerance with which to solve for the wave speeds [nondim]. real :: tol_merge ! The fractional change in estimated wave speed that is allowed @@ -1127,20 +1153,27 @@ end subroutine wave_speeds !! signs are typically used, so internal rescaling by consistent factors are used to avoid !! over- or underflow. subroutine tridiag_det(a, c, ks, ke, lam, det, ddet, row_scale) - real, dimension(:), intent(in) :: a !< Lower diagonal of matrix (first entry unused) - real, dimension(:), intent(in) :: c !< Upper diagonal of matrix (last entry unused) + real, dimension(:), intent(in) :: a !< Lower diagonal of matrix (first entry unused) [T2 L-2 ~> s2 m-2] + real, dimension(:), intent(in) :: c !< Upper diagonal of matrix (last entry unused) [T2 L-2 ~> s2 m-2] integer, intent(in) :: ks !< Starting index to use in determinant integer, intent(in) :: ke !< Ending index to use in determinant - real, intent(in) :: lam !< Value subtracted from b - real, intent(out):: det !< Determinant - real, intent(out):: ddet !< Derivative of determinant with lam - real, intent(in) :: row_scale !< A scaling factor of the rows of the - !! matrix to limit the growth of the determinant + real, intent(in) :: lam !< Value subtracted from b [T2 L-2 ~> s2 m-2] + real, intent(out):: det !< Determinant of the matrix in dynamically rescaled units that + !! depend on the number of rows and the cumulative magnitude of + !! det and are therefore difficult to interpret, but the units + !! of det/ddet are always in [T2 L-2 ~> s2 m-2] + real, intent(out):: ddet !< Derivative of determinant with lam in units that are dynamically + !! rescaled along with those of det, such that the units of + !! det/ddet are always in [T2 L-2 ~> s2 m-2] + real, intent(in) :: row_scale !< A scaling factor of the rows of the matrix to + !! limit the growth of the determinant [L2 s2 T-2 m-2 ~> 1] ! Local variables - real :: detKm1, detKm2 ! Cumulative value of the determinant for the previous two layers. - real :: ddetKm1, ddetKm2 ! Derivative of the cumulative determinant with lam for the previous two layers. - real, parameter :: rescale = 1024.0**4 ! max value of determinant allowed before rescaling - real :: I_rescale ! inverse of rescale + real :: detKm1, detKm2 ! Cumulative value of the determinant for the previous two layers in units + ! that vary with the number of layers that have been worked on [various] + real :: ddetKm1, ddetKm2 ! Derivative of the cumulative determinant with lam for the previous two + ! layers [various], but the units of detKm1/ddetKm1 are [T2 L-2 ~> s2 m-2] + real, parameter :: rescale = 1024.0**4 ! max value of determinant allowed before rescaling [nondim] + real :: I_rescale ! inverse of rescale [nondim] integer :: k ! row (layer interface) index I_rescale = 1.0 / rescale @@ -1175,7 +1208,7 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over !! which N2 is limited as monotonic for the purposes of - !! calculating the vertical modal structure. + !! calculating the vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited !! as monotonic for the purposes of calculating the !! vertical modal structure [Z ~> m]. @@ -1221,7 +1254,7 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over !! which N2 is limited as monotonic for the purposes of - !! calculating the vertical modal structure. + !! calculating the vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited !! as monotonic for the purposes of calculating the !! vertical modal structure [Z ~> m]. From b9daf2f201f60c9fc0d1da78df78591213f42d5a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jan 2023 07:12:05 -0500 Subject: [PATCH 137/213] +Add runtime parameter INTERNAL_WAVE_CG1_THRESH Made the CS argument mandatory for wave_speeds and added the new runtime parameter INTERNAL_WAVE_CG1_THRESH to specify the threshold first mode internal below which all higher mode speeds are reported as 0, replacing a previously hard-coded dimensional value. As a result of this change there is a new waves_CS element in diabatic_CS and a call to wave_speed_init from diabatic_driver_init. By default, all answers are bitwise identical, but there is a new entry in some MOM_parameter_doc files that have INTERNAL_TIDES=True. --- src/diagnostics/MOM_wave_speed.F90 | 49 ++++++++++++------- .../vertical/MOM_diabatic_driver.F90 | 13 ++++- 2 files changed, 42 insertions(+), 20 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 3dcad440ce..34669ae706 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -44,6 +44,11 @@ module MOM_wave_speed real :: min_speed2 = 0. !< The minimum mode 1 internal wave speed squared [L2 T-2 ~> m2 s-2] real :: wave_speed_tol = 0.001 !< The fractional tolerance with which to solve for the wave !! speeds [nondim] + real :: c1_thresh = -1.0 !< A minimal value of the first mode internal wave speed + !! below which all higher mode speeds are not calculated but + !! are simply reported as 0 [L T-1 ~> m s-1]. A non-negative + !! value must be specified via a call to wave_speed_init for + !! the subroutine wave_speeds to be used (but not wave_speed). type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic !! mode structure. integer :: remap_answer_date = 99991231 !< The vintage of the order of arithmetic and expressions to use @@ -162,7 +167,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed / wave_speed: "// & "Module must be initialized before it is used.") if (present(full_halos)) then ; if (full_halos) then @@ -657,7 +662,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] - type(wave_speed_CS), optional, intent(in) :: CS !< Wave speed control struct + type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire data domain. @@ -684,8 +689,6 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt] Rc ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] - real :: c1_thresh ! if c1 is below this value, don't bother calculating - ! cn values for higher modes [L T-1 ~> m s-1] real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and its ! derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. ! The exact value should not matter for the final result if it is an even power of 2. @@ -752,10 +755,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (present(CS)) then - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & - "Module must be initialized before it is used.") - endif + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed / wave_speeds: "// & + "Module must be initialized before it is used.") if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed @@ -765,26 +766,28 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) use_EOS = associated(tv%eqn_of_state) - c1_thresh = 0.01*US%m_s_to_L_T + if (CS%c1_thresh < 0.0) & + call MOM_error(FATAL, "INTERNAL_WAVE_CG1_THRESH must be set to a non-negative "//& + "value via wave_speed_init for wave_speeds to be used.") c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. - better_est = .false. ; if (present(CS)) better_est = CS%better_cg1_est + better_est = CS%better_cg1_est if (better_est) then - tol_solve = 0.001 ; if (present(CS)) tol_solve = CS%wave_speed_tol + tol_solve = CS%wave_speed_tol tol_Hfrac = 0.1*tol_solve ; tol_merge = tol_solve / real(nz) else tol_solve = 0.001 ; tol_Hfrac = 0.0001 ; tol_merge = 0.001 endif - cg1_min2 = 0.0 ; if (present(CS)) cg1_min2 = CS%min_speed2 + cg1_min2 = CS%min_speed2 ! Zero out all wave speeds. Values over land or for columns that are too weakly stratified ! are not changed from this zero value. cn(:,:,:) = 0.0 min_h_frac = tol_Hfrac / real(nz) - !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS, & + !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,CS,min_h_frac,use_EOS, & !$OMP Z_to_pres,tv,cn,g_Rho0,nmodes,cg1_min2,better_est, & - !$OMP c1_thresh,tol_solve,tol_merge,c2_scale) + !$OMP tol_solve,tol_merge,c2_scale) do j=js,je ! First merge very thin layers with the one above (or below if they are ! at the top). This also transposes the row order so that columns can @@ -1046,7 +1049,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Find other eigen values if c1 is of significant magnitude, > cn_thresh nrootsfound = 0 ! number of extra roots found (not including 1st root) - if (nmodes>1 .and. kc>=nmodes+1 .and. cn(i,j,1)>c1_thresh) then + if ((nmodes > 1) .and. (kc >= nmodes+1) .and. (cn(i,j,1) > CS%c1_thresh)) then ! Set the the range to look for the other desired eigen values ! set min value just greater than the 1st root (found above) lamMin = lam_1*(1.0 + tol_solve) @@ -1202,7 +1205,7 @@ end subroutine tridiag_det !> Initialize control structure for MOM_wave_speed subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & - remap_answer_date, better_speed_est, min_speed, wave_speed_tol) + remap_answer_date, better_speed_est, min_speed, wave_speed_tol, c1_thresh) type(wave_speed_CS), intent(inout) :: CS !< Wave speed control struct logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. @@ -1225,6 +1228,10 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de !! below which 0 is returned [L T-1 ~> m s-1]. real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] + real, optional, intent(in) :: c1_thresh !< A minimal value of the first mode internal wave speed + !! below which all higher mode speeds are not calculated but are + !! simply reported as 0 [L T-1 ~> m s-1]. A non-negative value + !! must be specified for wave_speeds to be used (but not wave_speed). ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1237,7 +1244,8 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction, & better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol, & - remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date) + remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date, & + c1_thresh=c1_thresh) ! The remap_answers_2018 argument here is irrelevant, because remapping is hard-coded to use PLM. call initialize_remapping(CS%remapping_CS, 'PLM', boundary_extrapolation=.false., & @@ -1247,7 +1255,7 @@ end subroutine wave_speed_init !> Sets internal parameters for MOM_wave_speed subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & - remap_answer_date, better_speed_est, min_speed, wave_speed_tol) + remap_answer_date, better_speed_est, min_speed, wave_speed_tol, c1_thresh) type(wave_speed_CS), intent(inout) :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent @@ -1271,6 +1279,10 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ !! below which 0 is returned [L T-1 ~> m s-1]. real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] + real, optional, intent(in) :: c1_thresh !< A minimal value of the first mode internal wave speed + !! below which all higher mode speeds are not calculated but are + !! simply reported as 0 [L T-1 ~> m s-1]. A non-negative value + !! must be specified for wave_speeds to be used (but not wave_speed). if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction @@ -1286,6 +1298,7 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ if (present(better_speed_est)) CS%better_cg1_est = better_speed_est if (present(min_speed)) CS%min_speed2 = min_speed**2 if (present(wave_speed_tol)) CS%wave_speed_tol = wave_speed_tol + if (present(c1_thresh)) CS%c1_thresh = c1_thresh end subroutine wave_speed_set_param diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 7cfcbfab07..fa08a8c3af 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -67,7 +67,7 @@ module MOM_diabatic_driver use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units -use MOM_wave_speed, only : wave_speeds +use MOM_wave_speed, only : wave_speeds, wave_speed_CS, wave_speed_init use MOM_wave_interface, only : wave_parameters_CS use MOM_stochastics, only : stochastic_CS @@ -239,6 +239,7 @@ module MOM_diabatic_driver type(int_tide_CS) :: int_tide !< Internal tide control structure type(opacity_CS) :: opacity !< Opacity control structure type(regularize_layers_CS) :: regularize_layers !< Regularize layer control structure + type(wave_speed_CS) :: wave_speed !< Wave speed control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -395,7 +396,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%uniform_test_cg > 0.0) then do m=1,CS%nMode ; cn_IGW(:,:,m) = CS%uniform_test_cg ; enddo else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, full_halos=.true.) + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, CS%wave_speed, full_halos=.true.) endif call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & @@ -2948,6 +2949,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Local variables real :: Kd ! A diffusivity used in the default for other tracer diffusivities [Z2 T-1 ~> m2 s-1] + real :: IGW_c1_thresh ! A threshold first mode internal wave speed below which all higher + ! mode speeds are not calculated but simply assigned a speed of 0 [L T-1 ~> m s-1]. logical :: use_temperature character(len=20) :: EN1, EN2, EN3 @@ -3045,6 +3048,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes "//& "that will be calculated.", default=1, do_not_log=.true.) + call get_param(param_file, mdl, "INTERNAL_WAVE_CG1_THRESH", IGW_c1_thresh, & + "A minimal value of the first mode internal wave speed below which all higher "//& + "mode speeds are not calculated but are simply reported as 0. This must be "//& + "non-negative for the wave_speeds routine to be used.", & + units="m s-1", default=0.01, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & "If positive, a uniform group velocity of internal tide for test case", & default=-1., units="m s-1", scale=US%m_s_to_L_T) @@ -3466,6 +3474,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) + call wave_speed_init(CS%wave_speed, c1_thresh=IGW_c1_thresh) endif physical_OBL_scheme = (CS%use_bulkmixedlayer .or. CS%use_KPP .or. CS%use_energetic_PBL) From c60aff159341a1e46cbcf11c00491e51a7ca9efd Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Sun, 22 Jan 2023 12:31:12 -0700 Subject: [PATCH 138/213] Add KE_visc_gl90 diagnostic (#305) * Add KE_visc_gl90 diagnostic KE_visc_gl90 is an alternative to the diagnostic GLwork. Both diagnostics describe the energetics of the GL90 parameterization, as part of the kinetic energy budget. * KE_visc_gl90 is consistent with KE_visc, and the remaining KE diagnostics. In particular, it is true that KE_visc_gl90 is exactly contained in KE_visc, i.e., we have that KE_visc - KE_visc_gl90 represents exactly the energetics of all viscosity contributions except the GL90 viscosity. * GLwork is not directly compatible with KE_visc, but is guaranteed to be sign-definite if summed in the vertical. --- src/diagnostics/MOM_diagnostics.F90 | 31 +++++++++++++++++-- .../vertical/MOM_vert_friction.F90 | 2 +- 2 files changed, 30 insertions(+), 3 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ad51ecfe5e..11a37c8589 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -83,6 +83,7 @@ module MOM_diagnostics integer :: id_PE_to_KE = -1, id_KE_BT = -1 integer :: id_KE_Coradv = -1, id_KE_adv = -1 integer :: id_KE_visc = -1, id_KE_stress = -1 + integer :: id_KE_visc_gl90 = -1 integer :: id_KE_horvisc = -1, id_KE_dia = -1 integer :: id_uh_Rlay = -1, id_vh_Rlay = -1 integer :: id_uhGM_Rlay = -1, id_vhGM_Rlay = -1 @@ -1121,6 +1122,25 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS call post_data(CS%id_KE_visc, KE_term, CS%diag) endif + if (CS%id_KE_visc_gl90 > 0) then + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + do k=1,nz + do j=js,je ; do I=Isq,Ieq + KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + enddo ; enddo + if (.not.G%symmetric) & + call do_group_pass(CS%pass_KE_uv, G%domain) + do j=js,je ; do i=is,ie + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1))) + enddo ; enddo + enddo + call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) + endif + if (CS%id_KE_stress > 0) then ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. do k=1,nz @@ -1803,6 +1823,9 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + CS%id_KE_visc_gl90 = register_diag_field('ocean_model', 'KE_visc_gl90', diag%axesTL, Time, & + 'Kinetic Energy Source from GL90 Vertical Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) @@ -2231,7 +2254,10 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - + if (CS%id_KE_visc_gl90 > 0) then + call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + endif if (CS%id_KE_stress > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) @@ -2245,7 +2271,8 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) CS%KE_term_on = ((CS%id_dKEdt > 0) .or. (CS%id_PE_to_KE > 0) .or. (CS%id_KE_BT > 0) .or. & (CS%id_KE_Coradv > 0) .or. (CS%id_KE_adv > 0) .or. (CS%id_KE_visc > 0) .or. & - (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. (CS%id_KE_dia > 0)) + (CS%id_KE_visc_gl90 > 0) .or. (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. & + (CS%id_KE_dia > 0)) if (CS%id_h_du_dt > 0) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) if (CS%id_h_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 88be824885..6488ba5b1b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2481,7 +2481,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_GLwork = register_diag_field('ocean_model', 'GLwork', diag%axesTL, Time, & - 'Kinetic Energy Source from GL90 Vertical Viscosity', & + 'Sign-definite Kinetic Energy Source from GL90 Vertical Viscosity', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) CS%id_du_dt_visc_gl90 = register_diag_field('ocean_model', 'du_dt_visc_gl90', diag%axesCuL, Time, & 'Zonal Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) From 321ee0b1bc863730f2c52e281654a0b73eecfc01 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 25 Oct 2022 13:49:13 -0400 Subject: [PATCH 139/213] Generic I/O layer for infra and netCDF This patch introduces a generalized I/O interface, through a new class, `MOM_file`, for reading and writing of axis-based model fields. A common API for interacting with files is defined in the `MOM_file` class, and two implementations are provided: * `MOM_infra_file`, using the "infra" framework (i.e. FMS) * `MOM_netcdf_file`, using native netCDF framework This separation allows us to define certain generic functions by class, and platform-specific functions by type. It will also allow for removal of legacy FMS1 operations which are no longer used for the majority of I/O but are still required for isolated MOM files. This change will allow us to move incompatible files from the FMS to the netCDF implementation, while still preserving a common structure for both files. The majority of the details of `MOM_file` and its subclasses are defined in `MOM_io_file.F90`, which is exclusively accessed through `MOM_io.F90`. The netCDF implementation, designed to be used by `MOM_netcdf_file` but is designed as a standalone system, is defined in `MOM_netcdf.F90`. *Interface* `MOM_file` includes the following functions: * `open` * `close` * `flush` * `register_axis` * `register_field` * `write_attribute` * `write_field` * `file_is_open` * `get_file_info` * `get_file_fields` * `get_field_atts` * `read_field_chksum` Most are designed to resemble the existing MOM I/O operations. Note that some of these have not yet been implemented for `MOM_netcdf_file`, since they are never used in the model. `MOM_file_infra` includes the following additional operations: * `get_file_times` * `get_file_fieldtypes` See documentation for usage of these functions. The "axis"/"field" model from FMS1 has been preserved, where axes are associated with variables which contain the grid point, and fields are defined with respect to the file's axes. Operations such as field counters will exclude any variables associated with the axes. The `axistype` and `fieldtype` from FMS have been replaced with new abstractions (`MOM_axis` and `MOM_field`). Internally, these point to either the FMS types or equivalent netCDF types. *Implementation* Each file type contains an instance of its native type, as well as lists of associated axes and fields. List are implemented as linked lists of names (stored as `label`) which are used to identify and extract or write the axis/field to the internal type. The mechanics of this are largely hidden from the user and can be changed in the future, if needed, without disruption to the rest of the codebase. The current netCDF implementation very closely mirrors the FMS infra behavior, but this can be relaxed or modified as needed. netCDF I/O is currently only designed for serial I/O, with all of the data on the root PE. Further development would be needed to support any kind of parallel I/O. *Current Usage* Two functions have been transferred from infra to the netCDF I/O: * `Depth_list.nc` * `ocean.stats.nc` The following legacy functions and types from FMS have been preserved: * `create_file` * `reopen_file` * `file_type` * `open_file` * `get_file_info` * `get_file_fields` * `get_file_times` This is primarily to preserve compatibility with SIS2, but may also be useful for other code, such as model drivers. These may be phased out in the future, however. --- config_src/infra/FMS2/MOM_io_infra.F90 | 4 +- src/ALE/MOM_hybgen_regrid.F90 | 13 +- src/ALE/MOM_regridding.F90 | 14 +- src/diagnostics/MOM_sum_output.F90 | 72 +- src/framework/MOM_io.F90 | 442 ++++- src/framework/MOM_io_file.F90 | 1654 +++++++++++++++++ src/framework/MOM_netcdf.F90 | 755 ++++++++ src/framework/MOM_restart.F90 | 48 +- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- .../MOM_coord_initialization.F90 | 12 +- .../MOM_shared_initialization.F90 | 12 +- 11 files changed, 2854 insertions(+), 174 deletions(-) create mode 100644 src/framework/MOM_io_file.F90 create mode 100644 src/framework/MOM_netcdf.F90 diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index c49c124ae0..54b9dfb78b 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -509,8 +509,8 @@ subroutine open_ASCII_file(unit, file, action, threading, fileset) ! This checks if open() failed but did not raise a runtime error. inquire(unit, opened=is_open) if (.not. is_open) & - call MOM_error(FATAL, 'open_ASCII_file: File ' // trim(filename) // & - ' failed to open.') + call MOM_error(FATAL, & + 'open_ASCII_file: File "' // trim(filename) // '" failed to open.') ! NOTE: There are two possible mpp_write_meta functions in FMS1: ! - call mpp_write_meta( unit, 'filename', cval=mpp_file(unit)%name) diff --git a/src/ALE/MOM_hybgen_regrid.F90 b/src/ALE/MOM_hybgen_regrid.F90 index 271caa7ad6..f89e15d930 100644 --- a/src/ALE/MOM_hybgen_regrid.F90 +++ b/src/ALE/MOM_hybgen_regrid.F90 @@ -7,7 +7,8 @@ module MOM_hybgen_regrid use MOM_EOS, only : EOS_type, calculate_density use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, assert use MOM_file_parser, only : get_param, param_file_type, log_param -use MOM_io, only : close_file, create_file, file_type, fieldtype, file_exists +use MOM_io, only : create_MOM_file, file_exists +use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, MOM_write_field, vardesc, var_desc, SINGLE_FILE use MOM_string_functions, only : slasher use MOM_unit_scaling, only : unit_scale_type @@ -210,20 +211,20 @@ subroutine write_Hybgen_coord_file(GV, CS, filepath) character(len=*), intent(in) :: filepath !< The full path to the file to write ! Local variables type(vardesc) :: vars(3) - type(fieldtype) :: fields(3) - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_field) :: fields(3) + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset vars(1) = var_desc("dp0", "meter", "Deep z-level minimum thicknesses for Hybgen", '1', 'L', '1') vars(2) = var_desc("ds0", "meter", "Shallow z-level minimum thicknesses for Hybgen", '1', 'L', '1') vars(3) = var_desc("Rho_tgt", "kg m-3", "Target coordinate potential densities for Hybgen", '1', 'L', '1') - call create_file(IO_handle, trim(filepath), vars, 3, fields, SINGLE_FILE, GV=GV) + call create_MOM_file(IO_handle, trim(filepath), vars, 3, fields, & + SINGLE_FILE, GV=GV) call MOM_write_field(IO_handle, fields(1), CS%dp0k, scale=CS%coord_scale) call MOM_write_field(IO_handle, fields(2), CS%ds0k, scale=CS%coord_scale) call MOM_write_field(IO_handle, fields(3), CS%target_density, scale=CS%Rho_coord_scale) - call close_file(IO_handle) - + call IO_handle%close() end subroutine write_Hybgen_coord_file !> This subroutine deallocates memory in the control structure for the hybgen module diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index e28f2c5e82..53072909a5 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -6,8 +6,9 @@ module MOM_regridding use MOM_error_handler, only : MOM_error, FATAL, WARNING, assert use MOM_file_parser, only : param_file_type, get_param, log_param use MOM_io, only : file_exists, field_exists, field_size, MOM_read_data -use MOM_io, only : vardesc, var_desc, fieldtype, SINGLE_FILE -use MOM_io, only : create_file, MOM_write_field, close_file, file_type +use MOM_io, only : vardesc, var_desc, SINGLE_FILE +use MOM_io, only : MOM_infra_file, MOM_field +use MOM_io, only : create_MOM_file, MOM_write_field use MOM_io, only : verify_variable_units, slasher use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_grid_type, thermo_var_ptrs @@ -2212,8 +2213,8 @@ subroutine write_regrid_file( CS, GV, filepath ) character(len=*), intent(in) :: filepath !< The full path to the file to write type(vardesc) :: vars(2) - type(fieldtype) :: fields(2) - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_field) :: fields(2) + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset real :: ds(GV%ke), dsi(GV%ke+1) if (CS%regridding_scheme == REGRIDDING_HYBGEN) then @@ -2231,10 +2232,11 @@ subroutine write_regrid_file( CS, GV, filepath ) vars(2) = var_desc('ds_interface', getCoordinateUnits( CS ), & 'Layer Center Coordinate Separation', '1', 'i', '1') - call create_file(IO_handle, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) + call create_MOM_file(IO_handle, trim(filepath), vars, 2, fields, & + SINGLE_FILE, GV=GV) call MOM_write_field(IO_handle, fields(1), ds) call MOM_write_field(IO_handle, fields(2), dsi) - call close_file(IO_handle) + call IO_handle%close() end subroutine write_regrid_file diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 7797a266dd..6dbe4997d6 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -13,8 +13,9 @@ module MOM_sum_output use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta -use MOM_io, only : create_file, file_type, fieldtype, flush_file, reopen_file, close_file -use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field, MOM_write_field +use MOM_io, only : create_MOM_file, reopen_MOM_file +use MOM_io, only : MOM_infra_file, MOM_netcdf_file, MOM_field +use MOM_io, only : file_exists, slasher, vardesc, var_desc, MOM_write_field use MOM_io, only : field_size, read_variable, read_attribute, open_ASCII_file, stdout use MOM_io, only : axis_info, set_axis_info, delete_axis_info, get_filename_appendix use MOM_io, only : attribute_info, set_attribute_info, delete_attribute_info @@ -125,9 +126,9 @@ module MOM_sum_output !! to stdout when the energy files are written. integer :: previous_calls = 0 !< The number of times write_energy has been called. integer :: prev_n = 0 !< The value of n from the last call. - type(file_type) :: fileenergy_nc !< The file handle for the netCDF version of the energy file. + type(MOM_netcdf_file) :: fileenergy_nc !< The file handle for the netCDF version of the energy file. integer :: fileenergy_ascii !< The unit number of the ascii version of the energy file. - type(fieldtype), dimension(NUM_FIELDS+MAX_FIELDS_) :: & + type(MOM_field), dimension(NUM_FIELDS+MAX_FIELDS_) :: & fields !< fieldtype variables for the output fields. character(len=200) :: energyfile !< The name of the energy file with path. end type sum_output_CS @@ -603,13 +604,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci energypath_nc = trim(CS%energyfile) // ".nc" if (day > CS%Start_time) then - call reopen_file(CS%fileenergy_nc, trim(energypath_nc), vars, & - num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, & - G=G, GV=GV) + call reopen_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & + num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) else - call create_file(CS%fileenergy_nc, trim(energypath_nc), vars, & - num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, & - G=G, GV=GV) + call create_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & + num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) endif endif @@ -863,35 +862,35 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci endif endif - call write_field(CS%fileenergy_nc, CS%fields(1), real(CS%ntrunc), reday) - call write_field(CS%fileenergy_nc, CS%fields(2), toten, reday) - call write_field(CS%fileenergy_nc, CS%fields(3), PE, reday) - call write_field(CS%fileenergy_nc, CS%fields(4), KE, reday) - call write_field(CS%fileenergy_nc, CS%fields(5), H_0APE, reday) - call write_field(CS%fileenergy_nc, CS%fields(6), mass_lay, reday) - - call write_field(CS%fileenergy_nc, CS%fields(7), mass_tot, reday) - call write_field(CS%fileenergy_nc, CS%fields(8), mass_chg, reday) - call write_field(CS%fileenergy_nc, CS%fields(9), mass_anom, reday) - call write_field(CS%fileenergy_nc, CS%fields(10), max_CFL(1), reday) - call write_field(CS%fileenergy_nc, CS%fields(11), max_CFL(2), reday) + call CS%fileenergy_nc%write_field(CS%fields(1), real(CS%ntrunc), reday) + call CS%fileenergy_nc%write_field(CS%fields(2), toten, reday) + call CS%fileenergy_nc%write_field(CS%fields(3), PE, reday) + call CS%fileenergy_nc%write_field(CS%fields(4), KE, reday) + call CS%fileenergy_nc%write_field(CS%fields(5), H_0APE, reday) + call CS%fileenergy_nc%write_field(CS%fields(6), mass_lay, reday) + + call CS%fileenergy_nc%write_field(CS%fields(7), mass_tot, reday) + call CS%fileenergy_nc%write_field(CS%fields(8), mass_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(9), mass_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(10), max_CFL(1), reday) + call CS%fileenergy_nc%write_field(CS%fields(11), max_CFL(2), reday) if (CS%use_temperature) then - call write_field(CS%fileenergy_nc, CS%fields(12), 0.001*Salt, reday) - call write_field(CS%fileenergy_nc, CS%fields(13), 0.001*salt_chg, reday) - call write_field(CS%fileenergy_nc, CS%fields(14), 0.001*salt_anom, reday) - call write_field(CS%fileenergy_nc, CS%fields(15), Heat, reday) - call write_field(CS%fileenergy_nc, CS%fields(16), heat_chg, reday) - call write_field(CS%fileenergy_nc, CS%fields(17), heat_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(12), 0.001*Salt, reday) + call CS%fileenergy_nc%write_field(CS%fields(13), 0.001*salt_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(14), 0.001*salt_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(15), Heat, reday) + call CS%fileenergy_nc%write_field(CS%fields(16), heat_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(17), heat_anom, reday) do m=1,nTr_stocks - call write_field(CS%fileenergy_nc, CS%fields(17+m), Tr_stocks(m), reday) + call CS%fileenergy_nc%write_field(CS%fields(17+m), Tr_stocks(m), reday) enddo else do m=1,nTr_stocks - call write_field(CS%fileenergy_nc, CS%fields(11+m), Tr_stocks(m), reday) + call CS%fileenergy_nc%write_field(CS%fields(11+m), Tr_stocks(m), reday) enddo endif - call flush_file(CS%fileenergy_nc) + call CS%fileenergy_nc%flush() if (is_NaN(En_mass)) then call MOM_error(FATAL, "write_energy : NaNs in total model energy forced model termination.") @@ -1233,13 +1232,13 @@ subroutine write_depth_list(G, US, DL, filename) ! Local variables type(vardesc), dimension(:), allocatable :: & vars ! Types that described the staggering and metadata for the fields - type(fieldtype), dimension(:), allocatable :: & + type(MOM_field), dimension(:), allocatable :: & fields ! Types with metadata about the variables that will be written type(axis_info), dimension(:), allocatable :: & extra_axes ! Descriptors for extra axes that might be used type(attribute_info), dimension(:), allocatable :: & global_atts ! Global attributes and their values - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_netcdf_file) :: IO_handle ! The I/O handle of the fileset character(len=16) :: depth_chksum, area_chksum ! All ranks are required to compute the global checksum @@ -1259,8 +1258,8 @@ subroutine write_depth_list(G, US, DL, filename) call set_attribute_info(global_atts(1), depth_chksum_attr, depth_chksum) call set_attribute_info(global_atts(2), area_chksum_attr, area_chksum) - call create_file(IO_handle, filename, vars, 3, fields, SINGLE_FILE, extra_axes=extra_axes, & - global_atts=global_atts) + call create_MOM_file(IO_handle, filename, vars, 3, fields, SINGLE_FILE, & + extra_axes=extra_axes, global_atts=global_atts) call MOM_write_field(IO_handle, fields(1), DL%depth, scale=US%Z_to_m) call MOM_write_field(IO_handle, fields(2), DL%area, scale=US%L_to_m**2) call MOM_write_field(IO_handle, fields(3), DL%vol_below, scale=US%Z_to_m*US%L_to_m**2) @@ -1268,8 +1267,7 @@ subroutine write_depth_list(G, US, DL, filename) call delete_axis_info(extra_axes) call delete_attribute_info(global_atts) deallocate(vars, extra_axes, fields, global_atts) - call close_file(IO_handle) - + call IO_handle%close() end subroutine write_depth_list !> This subroutine reads in the depth list from the specified file diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index e8df89b268..6c2dc9df34 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -15,15 +15,17 @@ module MOM_io use MOM_io_infra, only : read_field, read_vector use MOM_io_infra, only : read_data => read_field ! Deprecated use MOM_io_infra, only : read_field_chksum -use MOM_io_infra, only : file_type, file_exists, get_file_info, get_file_fields -use MOM_io_infra, only : open_file, open_ASCII_file, close_file, flush_file, file_is_open -use MOM_io_infra, only : get_field_size, fieldtype, field_exists, get_field_atts -use MOM_io_infra, only : get_file_times, axistype, get_axis_data, get_filename_suffix -use MOM_io_infra, only : write_field, write_metadata, write_version +use MOM_io_infra, only : file_exists +use MOM_io_infra, only : open_ASCII_file, close_file, file_is_open +use MOM_io_infra, only : get_field_size, field_exists, get_field_atts +use MOM_io_infra, only : get_axis_data, get_filename_suffix +use MOM_io_infra, only : write_version use MOM_io_infra, only : MOM_namelist_file, check_namelist_error, io_infra_init, io_infra_end use MOM_io_infra, only : APPEND_FILE, ASCII_FILE, MULTIPLE, NETCDF_FILE, OVERWRITE_FILE use MOM_io_infra, only : READONLY_FILE, SINGLE_FILE, WRITEONLY_FILE use MOM_io_infra, only : CENTER, CORNER, NORTH_FACE, EAST_FACE +use MOM_io_file, only : MOM_file, MOM_infra_file, MOM_netcdf_file +use MOM_io_file, only : MOM_axis, MOM_field use MOM_string_functions, only : lowercase, slasher use MOM_verticalGrid, only : verticalGrid_type @@ -33,21 +35,33 @@ module MOM_io use netcdf, only : NF90_strerror, NF90_inquire_dimension use netcdf, only : NF90_NOWRITE, NF90_NOERR, NF90_GLOBAL, NF90_ENOTATT, NF90_CHAR +! The following are not used in MOM6, but may be used by externals (e.g. SIS2). +use MOM_io_infra, only : axistype ! still used but soon to be nuked +use MOM_io_infra, only : fieldtype +use MOM_io_infra, only : file_type +use MOM_io_infra, only : get_file_info +use MOM_io_infra, only : get_file_fields +use MOM_io_infra, only : get_file_times +use MOM_io_infra, only : open_file +use MOM_io_infra, only : write_field + implicit none ; private ! These interfaces are actually implemented in this file. -public :: create_file, reopen_file, cmor_long_std, ensembler, MOM_io_init +public :: create_MOM_file, reopen_MOM_file, cmor_long_std, ensembler, MOM_io_init +public :: MOM_field public :: MOM_write_field, var_desc, modify_vardesc, query_vardesc, position_from_horgrid public :: open_namelist_file, check_namelist_error, check_nml_error public :: get_var_sizes, verify_variable_units, num_timelevels, read_variable, read_attribute public :: open_file_to_read, close_file_to_read ! The following are simple pass throughs of routines from MOM_io_infra or other modules. -public :: file_exists, open_file, open_ASCII_file, close_file, flush_file, file_type -public :: get_file_info, field_exists, get_file_fields, get_file_times, get_filename_appendix +public :: file_exists, open_ASCII_file, close_file +public :: MOM_file, MOM_infra_file, MOM_netcdf_file +public :: field_exists, get_filename_appendix public :: fieldtype, field_size, get_field_atts public :: axistype, get_axis_data public :: MOM_read_data, MOM_read_vector, read_field_chksum -public :: slasher, write_field, write_version_number +public :: slasher, write_version_number public :: io_infra_init, io_infra_end public :: stdout_if_root public :: get_var_axes_info @@ -67,6 +81,15 @@ module MOM_io !> These encoding constants are used to indicate the discretization position of a variable public :: CENTER, CORNER, NORTH_FACE, EAST_FACE +! The following are not used in MOM6, but may be used by externals (e.g. SIS2). +public :: create_file +public :: reopen_file +public :: file_type +public :: open_file +public :: get_file_info +public :: get_file_fields +public :: get_file_times + !> Read a field from file using the infrastructure I/O. interface MOM_read_data module procedure MOM_read_data_0d @@ -87,6 +110,11 @@ module MOM_io !> Write a registered field to an output file, potentially with rotation interface MOM_write_field + module procedure MOM_write_field_legacy_4d + module procedure MOM_write_field_legacy_3d + module procedure MOM_write_field_legacy_2d + module procedure MOM_write_field_legacy_1d + module procedure MOM_write_field_legacy_0d module procedure MOM_write_field_4d module procedure MOM_write_field_3d module procedure MOM_write_field_2d @@ -147,23 +175,70 @@ module MOM_io character(len=:), allocatable :: att_val !< The values of this attribute end type attribute_info - integer, public :: stdout = stdout_iso !< standard output unit integer, public :: stderr = stderr_iso !< standard output unit contains -!> Routine creates a new NetCDF file. It also sets up fieldtype -!! structures that describe this file and variables that will -!! later be written to this file. -subroutine create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G, dG, GV, checksums, extra_axes, global_atts) - type(file_type), intent(inout) :: IO_handle !< Handle for a files or fileset that is to be +!> `create_MOM_file` wrapper for the legacy file handle, `file_type`. +!! NOTE: This function may be removed in a future release. +subroutine create_file(IO_handle, filename, vars, novars, fields, threading, & + timeunit, G, dG, GV, checksums, extra_axes, global_atts) + type(file_type), intent(inout) :: IO_handle + !< Handle for a files or fileset that is to be opened or reopened for + !! writing + character(len=*), intent(in) :: filename + !< full path to the file to create + type(vardesc), intent(in) :: vars(:) + !< structures describing fields written to filename + integer, intent(in) :: novars + !< number of fields written to filename + type(fieldtype), intent(inout) :: fields(:) + !< array of fieldtypes for each variable + integer, optional, intent(in) :: threading + !< SINGLE_FILE or MULTIPLE + real, optional, intent(in) :: timeunit + !< length of the units for time [s]. The default value is 86400.0, for 1 + !! day. + type(ocean_grid_type), optional, intent(in) :: G + !< ocean horizontal grid structure; G or dG is required if the new file + !! uses any horizontal grid axes. + type(dyn_horgrid_type), optional, intent(in) :: dG + !< dynamic horizontal grid structure; G or dG is required if the new file + !! uses any horizontal grid axes. + type(verticalGrid_type), optional, intent(in) :: GV + !< ocean vertical grid structure, which is ! required if the new file uses + !! any vertical grid axes. + integer(kind=int64), optional, intent(in) :: checksums(:,:) + !< checksums of vars + type(axis_info), optional, intent(in) :: extra_axes(:) + !< Types with information about some axes that might be used in this file + type(attribute_info), optional, intent(in) :: global_atts(:) + !< Global attributes to write to this file + + type(MOM_infra_file) :: new_file + type(MOM_field) :: new_fields(novars) + + new_file%handle_infra = IO_handle + + call create_MOM_file(new_file, filename, vars, novars, new_fields, & + threading=threading, timeunit=timeunit, G=G, dG=dG, GV=GV, & + checksums=checksums, extra_axes=extra_axes, global_atts=global_atts) + + IO_handle = new_file%handle_infra + call new_file%get_file_fieldtypes(fields(:novars)) +end subroutine create_file + + +!! Create a new netCDF file and register the MOM_fields to be written. +subroutine create_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G, dG, GV, checksums, extra_axes, global_atts) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a files or fileset that is to be !! opened or reopened for writing character(len=*), intent(in) :: filename !< full path to the file to create type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename integer, intent(in) :: novars !< number of fields written to filename - type(fieldtype), intent(inout) :: fields(:) !< array of fieldtypes for each variable + type(MOM_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE real, optional, intent(in) :: timeunit !< length of the units for time [s]. The !! default value is 86400.0, for 1 day. @@ -186,10 +261,10 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim logical :: use_layer, use_int, use_periodic logical :: one_file, domain_set, dim_found logical, dimension(:), allocatable :: use_extra_axis - type(axistype) :: axis_lath, axis_latq, axis_lonh, axis_lonq - type(axistype) :: axis_layer, axis_int, axis_time, axis_periodic - type(axistype), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes - type(axistype) :: axes(5) ! The axes of a variable + type(MOM_axis) :: axis_lath, axis_latq, axis_lonh, axis_lonq + type(MOM_axis) :: axis_layer, axis_int, axis_time, axis_periodic + type(MOM_axis), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes + type(MOM_axis) :: axes(5) ! The axes of a variable type(MOM_domain_type), pointer :: Domain => NULL() type(domain1d) :: x_domain, y_domain integer :: position, numaxes, pack, thread, k, n, m @@ -244,9 +319,9 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then - call open_file(IO_handle, filename, OVERWRITE_FILE, threading=thread) + call IO_handle%open(filename, action=OVERWRITE_FILE, threading=thread) else - call open_file(IO_handle, filename, OVERWRITE_FILE, MOM_domain=Domain) + call IO_handle%open(filename, action=OVERWRITE_FILE, MOM_domain=Domain) endif ! Define the coordinates. @@ -326,28 +401,23 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim "create_file: A vertical grid type is required to create a file with a vertical coordinate.") if (use_lath) & - call write_metadata(IO_handle, axis_lath, name="lath", units=y_axis_units, longname="Latitude", & + axis_lath = IO_handle%register_axis("lath", units=y_axis_units, longname="Latitude", & cartesian='Y', domain=y_domain, data=gridLatT(jsg:jeg)) - if (use_lonh) & - call write_metadata(IO_handle, axis_lonh, name="lonh", units=x_axis_units, longname="Longitude", & + axis_lonh = IO_handle%register_axis("lonh", units=x_axis_units, longname="Longitude", & cartesian='X', domain=x_domain, data=gridLonT(isg:ieg)) - if (use_latq) & - call write_metadata(IO_handle, axis_latq, name="latq", units=y_axis_units, longname="Latitude", & + axis_latq = IO_handle%register_axis("latq", units=y_axis_units, longname="Latitude", & cartesian='Y', domain=y_domain, data=gridLatB(JsgB:JegB), edge_axis=.true.) - if (use_lonq) & - call write_metadata(IO_handle, axis_lonq, name="lonq", units=x_axis_units, longname="Longitude", & + axis_lonq = IO_handle%register_axis("lonq", units=x_axis_units, longname="Longitude", & cartesian='X', domain=x_domain, data=gridLonB(IsgB:IegB), edge_axis=.true.) - if (use_layer) & - call write_metadata(IO_handle, axis_layer, name="Layer", units=trim(GV%zAxisUnits), & + axis_layer = IO_handle%register_axis("Layer", units=trim(GV%zAxisUnits), & longname="Layer "//trim(GV%zAxisLongName), cartesian='Z', & sense=1, data=GV%sLayer(1:GV%ke)) - if (use_int) & - call write_metadata(IO_handle, axis_int, name="Interface", units=trim(GV%zAxisUnits), & + axis_int = IO_handle%register_axis("Interface", units=trim(GV%zAxisUnits), & longname="Interface "//trim(GV%zAxisLongName), cartesian='Z', & sense=1, data=GV%sInterface(1:GV%ke+1)) @@ -367,9 +437,9 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim write(time_units,'(es8.2," s")') timeunit endif - call write_metadata(IO_handle, axis_time, name="Time", units=time_units, longname="Time", cartesian='T') + axis_time = IO_handle%register_axis("Time", units=time_units, longname="Time", cartesian='T') else - call write_metadata(IO_handle, axis_time, name="Time", units="days", longname="Time", cartesian='T') + axis_time = IO_handle%register_axis("Time", units="days", longname="Time", cartesian='T') endif ; endif if (use_periodic) then @@ -378,24 +448,24 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim ! Define a periodic axis with unit labels. allocate(axis_val(num_periods)) do k=1,num_periods ; axis_val(k) = real(k) ; enddo - call write_metadata(IO_handle, axis_periodic, name="Period", units="nondimensional", & - longname="Periods for cyclical variables", cartesian='T', data=axis_val) + axis_periodic = IO_handle%register_axis("Period", units="nondimensional", & + longname="Periods for cyclical variables", cartesian='T', data=axis_val) deallocate(axis_val) endif do m=1,num_extra_dims ; if (use_extra_axis(m)) then if (allocated(extra_axes(m)%ax_data)) then - call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, & longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, & sense=extra_axes(m)%sense, data=extra_axes(m)%ax_data) elseif (trim(extra_axes(m)%cartesian) == "T") then - call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, & longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian) else ! FMS requires that non-time axes have variables that label their values, even if they are trivial. allocate (axis_val(extra_axes(m)%ax_size)) do k=1,extra_axes(m)%ax_size ; axis_val(k) = real(k) ; enddo - call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, & longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, & sense=extra_axes(m)%sense, data=axis_val) deallocate(axis_val) @@ -457,10 +527,10 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim pack = 1 if (present(checksums)) then - call write_metadata(IO_handle, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, & + fields(k) = IO_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, & vars(k)%longname, pack=pack, checksum=checksums(k,:)) else - call write_metadata(IO_handle, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, & + fields(k) = IO_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, & vars(k)%longname, pack=pack) endif enddo @@ -468,41 +538,92 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim if (present(global_atts)) then do n=1,size(global_atts) if (allocated(global_atts(n)%name) .and. allocated(global_atts(n)%att_val)) & - call write_metadata(IO_handle, global_atts(n)%name, global_atts(n)%att_val) + call IO_handle%write_attribute(global_atts(n)%name, global_atts(n)%att_val) enddo endif - ! Now actualy write the variables with the axis label values - if (use_lath) call write_field(IO_handle, axis_lath) - if (use_latq) call write_field(IO_handle, axis_latq) - if (use_lonh) call write_field(IO_handle, axis_lonh) - if (use_lonq) call write_field(IO_handle, axis_lonq) - if (use_layer) call write_field(IO_handle, axis_layer) - if (use_int) call write_field(IO_handle, axis_int) - if (use_periodic) call write_field(IO_handle, axis_periodic) + ! Now write the variables with the axis label values + if (use_lath) call IO_handle%write_field(axis_lath) + if (use_latq) call IO_handle%write_field(axis_latq) + if (use_lonh) call IO_handle%write_field(axis_lonh) + if (use_lonq) call IO_handle%write_field(axis_lonq) + if (use_layer) call IO_handle%write_field(axis_layer) + if (use_int) call IO_handle%write_field(axis_int) + if (use_periodic) call IO_handle%write_field(axis_periodic) do m=1,num_extra_dims ; if (use_extra_axis(m)) then - call write_field(IO_handle, more_axes(m)) + call IO_handle%write_field(more_axes(m)) endif ; enddo if (num_extra_dims > 0) then deallocate(use_extra_axis, more_axes) endif +end subroutine create_MOM_file + + +!> `reopen_MOM_file` wrapper for the legacy file handle, `file_type`. +!! NOTE: This function may be removed in a future release. +subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, & + timeunit, G, dG, GV, extra_axes, global_atts) + type(file_type), intent(inout) :: IO_handle + !< Handle for a file or fileset that is to be opened or reopened for + !! writing + character(len=*), intent(in) :: filename + !< full path to the file to create + type(vardesc), intent(in) :: vars(:) + !< structures describing fields written to filename + integer, intent(in) :: novars + !< number of fields written to filename + type(fieldtype), intent(inout) :: fields(:) + !< array of fieldtypes for each variable + integer, optional, intent(in) :: threading + !< SINGLE_FILE or MULTIPLE + real, optional, intent(in) :: timeunit + !< length of the units for time [s]. The default value is 86400.0, for 1 + !! day. + type(ocean_grid_type), optional, intent(in) :: G + !< ocean horizontal grid structure; G or dG is required if a new file uses + !! any horizontal grid axes. + type(dyn_horgrid_type), optional, intent(in) :: dG + !< dynamic horizontal grid structure; G or dG is required if a new file + !! uses any horizontal grid axes. + type(verticalGrid_type), optional, intent(in) :: GV + !< ocean vertical grid structure, which is required if a new file uses any + !! vertical grid axes. + type(axis_info), optional, intent(in) :: extra_axes(:) + !< Types with information about some axes that might be used in this file + type(attribute_info), optional, intent(in) :: global_atts(:) + !< Global attributes to write to this file + + type(MOM_infra_file) :: mfile + !< Wrapper to MOM file + type(MOM_field), allocatable :: mfields(:) + !< Wrapper to MOM fields + integer :: i -end subroutine create_file + mfile%handle_infra = IO_handle + allocate(mfields(size(fields))) + + call reopen_MOM_file(mfile, filename, vars, novars, mfields, & + threading=threading, timeunit=timeunit, G=G, dG=dG, GV=GV, & + extra_axes=extra_axes, global_atts=global_atts) + + IO_handle = mfile%handle_infra + call get_file_fields(IO_handle, fields) +end subroutine reopen_file !> This routine opens an existing NetCDF file for output. If it !! does not find the file, a new file is created. It also sets up !! structures that describe this file and the variables that will !! later be written to this file. -subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G, dG, GV, extra_axes, global_atts) - type(file_type), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be +subroutine reopen_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G, dG, GV, extra_axes, global_atts) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be !! opened or reopened for writing character(len=*), intent(in) :: filename !< full path to the file to create type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename integer, intent(in) :: novars !< number of fields written to filename - type(fieldtype), intent(inout) :: fields(:) !< array of fieldtypes for each variable + type(MOM_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE real, optional, intent(in) :: timeunit !< length of the units for time [s]. The !! default value is 86400.0, for 1 day. @@ -536,8 +657,9 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim inquire(file=check_name,EXIST=exists) if (.not.exists) then - call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G=G, dG=dG, GV=GV, extra_axes=extra_axes, global_atts=global_atts) + call create_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G=G, dG=dG, GV=GV, extra_axes=extra_axes, & + global_atts=global_atts) else domain_set = .false. @@ -551,40 +673,31 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then - call open_file(IO_handle, filename, APPEND_FILE, threading=thread) + call IO_handle%open(filename, APPEND_FILE, threading=thread) else - call open_file(IO_handle, filename, APPEND_FILE, MOM_domain=Domain) + call IO_handle%open(filename, APPEND_FILE, MOM_domain=Domain) endif - if (.not.file_is_open(IO_handle)) return + if (.not. IO_handle%file_is_open()) return - call get_file_info(IO_handle, nvar=nvar) + call IO_handle%get_file_info(nvar=nvar) if (nvar == -1) then write (mesg,*) "Reopening file ",trim(filename)," apparently had ",nvar,& " variables. Clobbering and creating file with ",novars," instead." call MOM_error(WARNING,"MOM_io: "//mesg) - call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G=G, dG=dG, GV=GV, extra_axes=extra_axes, global_atts=global_atts) + call create_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G=G, dG=dG, GV=GV, extra_axes=extra_axes, & + global_atts=global_atts) elseif (nvar /= novars) then write (mesg,*) "Reopening file ",trim(filename)," with ",novars,& " variables instead of ",nvar,"." call MOM_error(FATAL,"MOM_io: "//mesg) endif - if (nvar > 0) call get_file_fields(IO_handle, fields(1:nvar)) - - ! Check for inconsistent field names... -! do i=1,nvar -! call get_field_atts(fields(i), name) -! !if (trim(name) /= trim(vars%name)) then -! ! write (mesg, '("Reopening file ",a," variable ",a," is called ",a,".")',& -! ! trim(filename), trim(vars%name), trim(name)) -! ! call MOM_error(NOTE, "MOM_io: "//trim(mesg)) -! !endif -! enddo + if (nvar > 0) call IO_handle%get_file_fields(fields(1:nvar)) endif +end subroutine reopen_MOM_file -end subroutine reopen_file !> Return the index of sdtout if called from the root PE, or 0 for other PEs. integer function stdout_if_root() @@ -2089,9 +2202,8 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data endif end subroutine MOM_read_vector_3d - !> Write a 4d field to an output file, potentially with rotation -subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & +subroutine MOM_write_field_legacy_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata @@ -2122,10 +2234,11 @@ subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, ti tile_count=tile_count, fill_value=fill_value) deallocate(field_rot) endif -end subroutine MOM_write_field_4d +end subroutine MOM_write_field_legacy_4d + !> Write a 3d field to an output file, potentially with rotation -subroutine MOM_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & +subroutine MOM_write_field_legacy_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata @@ -2156,10 +2269,11 @@ subroutine MOM_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, ti tile_count=tile_count, fill_value=fill_value) deallocate(field_rot) endif -end subroutine MOM_write_field_3d +end subroutine MOM_write_field_legacy_3d + !> Write a 2d field to an output file, potentially with rotation -subroutine MOM_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & +subroutine MOM_write_field_legacy_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata @@ -2190,10 +2304,11 @@ subroutine MOM_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, ti tile_count=tile_count, fill_value=fill_value) deallocate(field_rot) endif -end subroutine MOM_write_field_2d +end subroutine MOM_write_field_legacy_2d + !> Write a 1d field to an output file -subroutine MOM_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, scale) +subroutine MOM_write_field_legacy_1d(IO_handle, field_md, field, tstamp, fill_value, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata real, dimension(:), intent(in) :: field !< Field to write @@ -2219,10 +2334,11 @@ subroutine MOM_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, sc call write_field(IO_handle, field_md, array, tstamp=tstamp) deallocate(array) endif -end subroutine MOM_write_field_1d +end subroutine MOM_write_field_legacy_1d + !> Write a 0d field to an output file -subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, scale) +subroutine MOM_write_field_legacy_0d(IO_handle, field_md, field, tstamp, fill_value, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata real, intent(in) :: field !< Field to write @@ -2237,6 +2353,156 @@ subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, sc if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif call write_field(IO_handle, field_md, scaled_val, tstamp=tstamp) +end subroutine MOM_write_field_legacy_0d + + +!> Write a 4d field to an output file, potentially with rotation +subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns, scale) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write + real, optional, intent(in) :: tstamp !< Model timestamp + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that the field is + !! multiplied by before it is written + + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units or rescaled + real :: scale_fac ! A scaling factor to use before writing the array + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if ((qturns == 0) .and. (scale_fac == 1.0)) then + call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + else + call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) + call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_4d + +!> Write a 3d field to an output file, potentially with rotation +subroutine MOM_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns, scale) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write + real, optional, intent(in) :: tstamp !< Model timestamp + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that the field is + !! multiplied by before it is written + + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units or rescaled + real :: scale_fac ! A scaling factor to use before writing the array + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if ((qturns == 0) .and. (scale_fac == 1.0)) then + call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + else + call allocate_rotated_array(field, [1,1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) + call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_3d + +!> Write a 2d field to an output file, potentially with rotation +subroutine MOM_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns, scale) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field !< Unrotated field to write + real, optional, intent(in) :: tstamp !< Model timestamp + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that the field is + !! multiplied by before it is written + + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units + real :: scale_fac ! A scaling factor to use before writing the array + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if ((qturns == 0) .and. (scale_fac == 1.0)) then + call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + else + call allocate_rotated_array(field, [1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) + call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_2d + +!> Write a 1d field to an output file +subroutine MOM_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, scale) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata + real, dimension(:), intent(in) :: field !< Field to write + real, optional, intent(in) :: tstamp !< Model timestamp + real, optional, intent(in) :: fill_value !< Missing data fill value + real, optional, intent(in) :: scale !< A scaling factor that the field is + !! multiplied by before it is written + + real, dimension(:), allocatable :: array ! A rescaled copy of field + real :: scale_fac ! A scaling factor to use before writing the array + integer :: i + + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if (scale_fac == 1.0) then + call IO_handle%write_field(field_md, field, tstamp=tstamp) + else + allocate(array(size(field))) + array(:) = scale_fac * field(:) + if (present(fill_value)) then + do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo + endif + call IO_handle%write_field(field_md, array, tstamp=tstamp) + deallocate(array) + endif +end subroutine MOM_write_field_1d + +!> Write a 0d field to an output file +subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, scale) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata + real, intent(in) :: field !< Field to write + real, optional, intent(in) :: tstamp !< Model timestamp + real, optional, intent(in) :: fill_value !< Missing data fill value + real, optional, intent(in) :: scale !< A scaling factor that the field is + !! multiplied by before it is written + real :: scaled_val ! A rescaled copy of field + + scaled_val = field + if (present(scale)) scaled_val = scale*field + if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif + + call IO_handle%write_field(field_md, scaled_val, tstamp=tstamp) end subroutine MOM_write_field_0d !> Given filename and fieldname, this subroutine returns the size of the field in the file diff --git a/src/framework/MOM_io_file.F90 b/src/framework/MOM_io_file.F90 new file mode 100644 index 0000000000..68c0f33f07 --- /dev/null +++ b/src/framework/MOM_io_file.F90 @@ -0,0 +1,1654 @@ +!> This module contains the MOM file handler types +module MOM_io_file + +! This file is part of MOM6. See LICENSE.md for the license. + +use, intrinsic :: iso_fortran_env, only : int64 + +use MOM_domains, only : MOM_domain_type, domain1D +use MOM_io_infra, only : file_type, get_file_info, get_file_fields +use MOM_io_infra, only : open_file, close_file, flush_file +use MOM_io_infra, only : fms2_file_is_open => file_is_open +use MOM_io_infra, only : fieldtype +use MOM_io_infra, only : get_file_times, axistype +use MOM_io_infra, only : write_field, write_metadata +use MOM_io_infra, only : get_field_atts +use MOM_io_infra, only : read_field_chksum + +use MOM_netcdf, only : netcdf_file_type +use MOM_netcdf, only : netcdf_axis +use MOM_netcdf, only : netcdf_field +use MOM_netcdf, only : open_netcdf_file +use MOM_netcdf, only : close_netcdf_file +use MOM_netcdf, only : flush_netcdf_file +use MOM_netcdf, only : register_netcdf_axis +use MOM_netcdf, only : register_netcdf_field +use MOM_netcdf, only : write_netcdf_field +use MOM_netcdf, only : write_netcdf_axis +use MOM_netcdf, only : write_netcdf_attribute +use MOM_netcdf, only : get_netcdf_size +use MOM_netcdf, only : get_netcdf_fields + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_error_handler, only : is_root_PE + +implicit none ; private + +public :: MOM_file +public :: MOM_infra_file +public :: MOM_netcdf_file +public :: MOM_axis +public :: MOM_field + + +! Internal types + +! NOTE: MOM_axis and MOM_field do not represent the actual axes and +! fields stored in the file. They are only very thin wrappers to the keys (as +! strings) used to reference the associated object inside the MOM_file. + +!> Handle for axis in MOM file +type :: MOM_axis + character(len=:), allocatable :: label + !< Identifier for the axis in handle's list +end type MOM_axis + + +!> Linked list of framework axes +type :: axis_list_infra + private + type(axis_node_infra), pointer :: head => null() + !< Head of axis linked list + type(axis_node_infra), pointer :: tail => null() + !< Tail of axis linked list +contains + !> Initialize the framework axis list + procedure :: init => initialize_axis_list_infra + !> Append a new axis to the framework axis list + procedure :: append => append_axis_list_infra + !> Get an axis from the framework axis list + procedure :: get => get_axis_list_infra + !> Deallocate the framework axis list + procedure :: finalize => finalize_axis_list_infra +end type axis_list_infra + + +!> Framework axis linked list node +type :: axis_node_infra + private + character(len=:), allocatable :: label + !< Axis identifier + type(axis_node_infra), pointer :: next => null() + !< Pointer to next axis node + type(axistype) :: axis + !< Axis node contents +end type axis_node_infra + + +!> Linked list of framework axes +type :: axis_list_nc + private + type(axis_node_nc), pointer :: head => null() + !< Head of axis linked list + type(axis_node_nc), pointer :: tail => null() + !< Tail of axis linked list +contains + !> Initialize the netCDF axis list + procedure :: init => initialize_axis_list_nc + !> Append a new axis to the netCDF axis list + procedure :: append => append_axis_list_nc + !> Get an axis from the netCDF axis list + procedure :: get => get_axis_list_nc + !> Deallocate the netCDF axis list + procedure :: finalize => finalize_axis_list_nc +end type axis_list_nc + + +!> Framework axis linked list node +type :: axis_node_nc + private + character(len=:), allocatable :: label + !< Axis identifier + type(axis_node_nc), pointer :: next => null() + !< Pointer to next axis node + type(netcdf_axis) :: axis + !< Axis node contents +end type axis_node_nc + + +!> Handle for field in MOM file +type :: MOM_field + character(len=:), allocatable :: label + !< Identifier for the field in the handle's list +end type MOM_field + + +!> Linked list of framework fields +type :: field_list_infra + private + type(field_node_infra), pointer :: head => null() + !< Head of field linked list + type(field_node_infra), pointer :: tail => null() + !< Tail of field linked list +contains + !> Initialize the framework field list + procedure :: init => initialize_field_list_infra + !> Append a new axis to the framework field list + procedure :: append => append_field_list_infra + !> Get an axis from the framework field list + procedure :: get => get_field_list_infra + !> Deallocate the framework field list + procedure :: finalize => finalize_field_list_infra +end type field_list_infra + + +!> Framework field linked list node +type :: field_node_infra + private + character(len=:), allocatable :: label + !< Field identifier + type(fieldtype) :: field + !< Field node contents + type(field_node_infra), pointer :: next => null() + !< Pointer to next field node +end type field_node_infra + + +!> Linked list of framework fields +type :: field_list_nc + private + type(field_node_nc), pointer :: head => null() + !< Head of field linked list + type(field_node_nc), pointer :: tail => null() + !< Tail of field linked list +contains + !> Initialize the netCDF field list + procedure :: init => initialize_field_list_nc + !> Append a new axis to the netCDF field list + procedure :: append => append_field_list_nc + !> Get an axis from the netCDF field list + procedure :: get => get_field_list_nc + !> Deallocate the netCDF field list + procedure :: finalize => finalize_field_list_nc +end type field_list_nc + + +!> Framework field linked list node +type :: field_node_nc + private + character(len=:), allocatable :: label + !< Field identifier + type(netcdf_field) :: field + !< Field node contents + type(field_node_nc), pointer :: next => null() + !< Pointer to next field node +end type field_node_nc + + +!> Generic MOM file abstraction for common operations +type, abstract :: MOM_file + private + + contains + + !> Open a file and connect to the MOM_file object + procedure(i_open_file), deferred :: open + !> Close the MOM file + procedure(i_close_file), deferred :: close + !> Flush buffered output to the MOM file + procedure(i_flush_file), deferred :: flush + + !> Register an axis to the MOM file + procedure(i_register_axis), deferred :: register_axis + !> Register a field to the MOM file + procedure(i_register_field), deferred :: register_field + !> Write metadata to the MOM file + procedure(i_write_attribute), deferred :: write_attribute + + !> Write field to a MOM file + generic :: write_field => & + write_field_4d, & + write_field_3d, & + write_field_2d, & + write_field_1d, & + write_field_0d, & + write_field_axis + + !> Write a 4D field to the MOM file + procedure(i_write_field_4d), deferred :: write_field_4d + !> Write a 3D field to the MOM file + procedure(i_write_field_3d), deferred :: write_field_3d + !> Write a 2D field to the MOM file + procedure(i_write_field_2d), deferred :: write_field_2d + !> Write a 1D field to the MOM file + procedure(i_write_field_1d), deferred :: write_field_1d + !> Write a 0D field to the MOM file + procedure(i_write_field_0d), deferred :: write_field_0d + !> Write an axis field to the MOM file + procedure(i_write_field_axis), deferred :: write_field_axis + + !> Return true if MOM file has been opened + procedure(i_file_is_open), deferred :: file_is_open + !> Return number of dimensions, variables, or time levels in a MOM file + procedure(i_get_file_info), deferred :: get_file_info + !> Get field objects from a MOM file + procedure(i_get_file_fields), deferred :: get_file_fields + !> Get attributes from a field + procedure(i_get_field_atts), deferred :: get_field_atts + !> Get checksum from a field + procedure(i_read_field_chksum), deferred :: read_field_chksum +end type MOM_file + + +!> MOM file from the supporting framework ("infra") layer +type, extends(MOM_file) :: MOM_infra_file + private + + ! NOTE: This will be made private after the API transition + type(file_type), public :: handle_infra + !< Framework-specific file handler content + type(axis_list_infra) :: axes + !< List of axes in file + type(field_list_infra) :: fields + !< List of fields in file + + contains + + !> Open a framework file and connect to the MOM_file object + procedure :: open => open_file_infra + !> Close the MOM framework file + procedure :: close => close_file_infra + !> Flush buffered output to the MOM framework file + procedure :: flush => flush_file_infra + + !> Register an axis to the MOM framework file + procedure :: register_axis => register_axis_infra + !> Register a field to the MOM framework file + procedure :: register_field => register_field_infra + !> Write global metadata to the MOM framework file + procedure :: write_attribute => write_attribute_infra + + !> Write a 4D field to the MOM framework file + procedure :: write_field_4d => write_field_4d_infra + !> Write a 3D field to the MOM framework file + procedure :: write_field_3d => write_field_3d_infra + !> Write a 2D field to the MOM framework file + procedure :: write_field_2d => write_field_2d_infra + !> Write a 1D field to the MOM framework file + procedure :: write_field_1d => write_field_1d_infra + !> Write a 0D field to the MOM framework file + procedure :: write_field_0d => write_field_0d_infra + !> Write an axis field to the MOM framework file + procedure :: write_field_axis => write_field_axis_infra + + !> Return true if MOM infra file has been opened + procedure :: file_is_open => file_is_open_infra + !> Return number of dimensions, variables, or time levels in a MOM infra file + procedure :: get_file_info => get_file_info_infra + !> Get field metadata from a MOM infra file + procedure :: get_file_fields => get_file_fields_infra + !> Get attributes from a field + procedure :: get_field_atts => get_field_atts_infra + !> Get checksum from a field + procedure :: read_field_chksum => read_field_chksum_infra + + ! MOM_infra_file methods + ! NOTE: These could naturally reside in MOM_file but is currently not needed. + + !> Get time levels of a MOM framework file + procedure :: get_file_times => get_file_times_infra + + !> Get the fields as fieldtypes from a file + procedure :: get_file_fieldtypes + ! NOTE: This is provided to support the legacy API and may be removed. +end type MOM_infra_file + + +!> MOM file using netCDF backend +type, extends(MOM_file) :: MOM_netcdf_file + private + + !> Framework-specific file handler content + type(netcdf_file_type) :: handle_nc + !> List of netCDF axes + type(axis_list_nc) :: axes + !> List of netCDF fields + type(field_list_nc) :: fields + !> True if the file has been opened + logical :: is_open = .false. + + contains + + !> Open a framework file and connect to the MOM_netcdf_file object + procedure :: open => open_file_nc + !> Close the MOM netcdf file + procedure :: close => close_file_nc + !> Flush buffered output to the MOM netcdf file + procedure :: flush => flush_file_nc + + !> Register an axis to the MOM netcdf file + procedure :: register_axis => register_axis_nc + !> Register a field to the MOM netcdf file + procedure :: register_field => register_field_nc + !> Write global metadata to the MOM netcdf file + procedure :: write_attribute => write_attribute_nc + + !> Write a 4D field to the MOM netcdf file + procedure :: write_field_4d => write_field_4d_nc + !> Write a 3D field to the MOM netcdf file + procedure :: write_field_3d => write_field_3d_nc + !> Write a 2D field to the MOM netcdf file + procedure :: write_field_2d => write_field_2d_nc + !> Write a 1D field to the MOM netcdf file + procedure :: write_field_1d => write_field_1d_nc + !> Write a 0D field to the MOM netcdf file + procedure :: write_field_0d => write_field_0d_nc + !> Write an axis field to the MOM netcdf file + procedure :: write_field_axis => write_field_axis_nc + + !> Return true if MOM netcdf file has been opened + procedure :: file_is_open => file_is_open_nc + !> Return number of dimensions, variables, or time levels in a MOM netcdf file + procedure :: get_file_info => get_file_info_nc + !> Get field metadata from a MOM netcdf file + procedure :: get_file_fields => get_file_fields_nc + !> Get attributes from a netCDF field + procedure :: get_field_atts => get_field_atts_nc + !> Get checksum from a netCDF field + procedure :: read_field_chksum => read_field_chksum_nc +end type MOM_netcdf_file + + +interface + !> Interface for opening a MOM file + subroutine i_open_file(handle, filename, action, MOM_domain, threading, fileset) + import :: MOM_file, MOM_domain_type + + class(MOM_file), intent(inout) :: handle + !< The handle for the opened file + character(len=*), intent(in) :: filename + !< The path name of the file being opened + integer, optional, intent(in) :: action + !< A flag indicating whether the file can be read or written to and how + !! to handle existing files. The default is WRITE_ONLY. + type(MOM_domain_type), optional, intent(in) :: MOM_Domain + !< A MOM_Domain that describes the decomposition + integer, optional, intent(in) :: threading + !< A flag indicating whether one (SINGLE_FILE) or multiple PEs (MULTIPLE) + !! participate in I/O. With the default, the root PE does I/O. + integer, optional, intent(in) :: fileset + !< A flag indicating whether multiple PEs doing I/O due to + !! threading=MULTIPLE write to the same file (SINGLE_FILE) or to one file + !! per PE (MULTIPLE, the default). + end subroutine i_open_file + + + !> Interface for closing a MOM file + subroutine i_close_file(handle) + import :: MOM_file + class(MOM_file), intent(inout) :: handle + !< The MOM file to be closed + end subroutine i_close_file + + + !> Interface for flushing I/O in a MOM file + subroutine i_flush_file(handle) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< The MOM file to be flushed + end subroutine i_flush_file + + + !> Interface to register an axis to a MOM file + function i_register_axis(handle, label, units, longname, cartesian, sense, & + domain, data, edge_axis, calendar) result(axis) + import :: MOM_file, MOM_axis, domain1D + + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: label + !< The name in the file of this axis + character(len=*), intent(in) :: units + !< The units of this axis + character(len=*), intent(in) :: longname + !< The long description of this axis + character(len=*), optional, intent(in) :: cartesian + !< A variable indicating which direction this axis corresponds with. + !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer, optional, intent(in) :: sense + !< This is 1 for axes whose values increase upward, or -1 if they + !! increase downward. + type(domain1D), optional, intent(in) :: domain + !< The domain decomposion for this axis + real, dimension(:), optional, intent(in) :: data + !< The coordinate values of the points on this axis + logical, optional, intent(in) :: edge_axis + !< If true, this axis marks an edge of the tracer cells + character(len=*), optional, intent(in) :: calendar + !< The name of the calendar used with a time axis + type(MOM_axis) :: axis + !< IO handle for axis in MOM_file + end function i_register_axis + + + !> Interface to register a field to a netCDF file + function i_register_field(handle, axes, label, units, longname, & + pack, standard_name, checksum) result(field) + import :: MOM_file, MOM_axis, MOM_field, int64 + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axes(:) + !< Handles for the axis used for this variable + character(len=*), intent(in) :: label + !< The name in the file of this variable + character(len=*), intent(in) :: units + !< The units of this variable + character(len=*), intent(in) :: longname + !< The long description of this variable + integer, optional, intent(in) :: pack + !< A precision reduction factor with which the variable. The default, 1, + !! has no reduction, but 2 is not uncommon. + character(len=*), optional, intent(in) :: standard_name + !< The standard (e.g., CMOR) name for this variable + integer(kind=int64), dimension(:), optional, intent(in) :: checksum + !< Checksum values that can be used to verify reads. + type(MOM_field) :: field + !< IO handle for field in MOM_file + end function i_register_field + + + !> Interface for writing global metata to a MOM file + subroutine i_write_attribute(handle, name, attribute) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: name + !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute + !< The value of this attribute + end subroutine i_write_attribute + + + !> Interface to write_field_4d() + subroutine i_write_field_4d(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + import :: MOM_file, MOM_field, MOM_domain_type + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + end subroutine i_write_field_4d + + + !> Interface to write_field_3d() + subroutine i_write_field_3d(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + import :: MOM_file, MOM_field, MOM_domain_type + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + end subroutine i_write_field_3d + + + !> Interface to write_field_2d() + subroutine i_write_field_2d(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + import :: MOM_file, MOM_field, MOM_domain_type + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + end subroutine i_write_field_2d + + + !> Interface to write_field_1d() + subroutine i_write_field_1d(handle, field_md, field, tstamp) + import :: MOM_file, MOM_field + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, dimension(:), intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + end subroutine i_write_field_1d + + + !> Interface to write_field_0d() + subroutine i_write_field_0d(handle, field_md, field, tstamp) + import :: MOM_file, MOM_field + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + end subroutine i_write_field_0d + + + !> Interface to write_field_axis() + subroutine i_write_field_axis(handle, axis) + import :: MOM_file, MOM_axis + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axis + !< An axis type variable with information to write + end subroutine i_write_field_axis + + + !> Interface to file_is_open() + logical function i_file_is_open(handle) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< Handle to a file to inquire about + end function i_file_is_open + + + !> Interface to get_file_info() + subroutine i_get_file_info(handle, ndim, nvar, ntime) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< Handle for a file that is open for I/O + integer, optional, intent(out) :: ndim + !< The number of dimensions in the file + integer, optional, intent(out) :: nvar + !< The number of variables in the file + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + end subroutine i_get_file_info + + + !> Interface to get_file_fields() + subroutine i_get_file_fields(handle, fields) + import :: MOM_file, MOM_field + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), dimension(:), intent(inout) :: fields + !< Field-type descriptions of all of the variables in a file. + end subroutine i_get_file_fields + + + !> Interface to get_field_atts() + subroutine i_get_field_atts(handle, field, name, units, longname, checksum) + import :: MOM_file, MOM_field, int64 + class(MOM_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field to extract information from + character(len=*), optional, intent(out) :: name + !< The variable name + character(len=*), optional, intent(out) :: units + !< The units of the variable + character(len=*), optional, intent(out) :: longname + !< The long name of the variable + integer(kind=int64), optional, intent(out) :: checksum(:) + !< The checksums of the variable in a file + end subroutine i_get_field_atts + + + !> Interface to read_field_chksum + subroutine i_read_field_chksum(handle, field, chksum, valid_chksum) + import :: MOM_file, MOM_field, int64 + class(MOM_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field whose checksum attribute is to be read + integer(kind=int64), intent(out) :: chksum + !< The checksum for the field. + logical, intent(out) :: valid_chksum + !< If true, chksum has been successfully read + end subroutine i_read_field_chksum +end interface + +contains + +!> Initialize the linked list of framework axes +subroutine initialize_axis_list_infra(list) + class(axis_list_infra), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_axis_list_infra + + +!> Append a new axis to the list +subroutine append_axis_list_infra(list, axis, label) + class(axis_list_infra), intent(inout) :: list + type(axistype), intent(in) :: axis + character(len=*), intent(in) :: label + + type(axis_node_infra), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%axis = axis + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_axis_list_infra + + +!> Get axis based on label +function get_axis_list_infra(list, label) result(axis) + class(axis_list_infra), intent(in) :: list + character(len=*), intent(in) :: label + type(axistype) :: axis + + type(axis_node_infra), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "axis associated with " // label // " not found.") + + axis = node%axis +end function get_axis_list_infra + + +!> Deallocate axes of list +subroutine finalize_axis_list_infra(list) + class(axis_list_infra), intent(inout) :: list + + type(axis_node_infra), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_axis_list_infra + + +!> Initialize the linked list of framework axes +subroutine initialize_axis_list_nc(list) + class(axis_list_nc), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_axis_list_nc + + +!> Append a new axis to the list +subroutine append_axis_list_nc(list, axis, label) + class(axis_list_nc), intent(inout) :: list + type(netcdf_axis), intent(in) :: axis + character(len=*), intent(in) :: label + + type(axis_node_nc), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%axis = axis + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_axis_list_nc + + +!> Get axis based on label +function get_axis_list_nc(list, label) result(axis) + class(axis_list_nc), intent(in) :: list + character(len=*), intent(in) :: label + type(netcdf_axis) :: axis + + type(axis_node_nc), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "axis associated with " // label // " not found.") + + axis = node%axis +end function get_axis_list_nc + + +!> Deallocate axes of list +subroutine finalize_axis_list_nc(list) + class(axis_list_nc), intent(inout) :: list + + type(axis_node_nc), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_axis_list_nc + + +!> Initialize the linked list of framework axes +subroutine initialize_field_list_infra(list) + class(field_list_infra), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_field_list_infra + + +!> Append a new field to the list +subroutine append_field_list_infra(list, field, label) + class(field_list_infra), intent(inout) :: list + type(fieldtype), intent(in) :: field + character(len=*), intent(in) :: label + + type(field_node_infra), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%field = field + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_field_list_infra + + +!> Get axis based on label +function get_field_list_infra(list, label) result(field) + class(field_list_infra), intent(in) :: list + character(len=*), intent(in) :: label + type(fieldtype) :: field + + type(field_node_infra), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "field associated with " // label // " not found.") + + field = node%field +end function get_field_list_infra + + +!> Deallocate fields of list +subroutine finalize_field_list_infra(list) + class(field_list_infra), intent(inout) :: list + + type(field_node_infra), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_field_list_infra + + +!> Initialize the linked list of framework axes +subroutine initialize_field_list_nc(list) + class(field_list_nc), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_field_list_nc + + +!> Append a new field to the list +subroutine append_field_list_nc(list, field, label) + class(field_list_nc), intent(inout) :: list + type(netcdf_field), intent(in) :: field + character(len=*), intent(in) :: label + + type(field_node_nc), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%field = field + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_field_list_nc + + +!> Get axis based on label +function get_field_list_nc(list, label) result(field) + class(field_list_nc), intent(in) :: list + character(len=*), intent(in) :: label + type(netcdf_field) :: field + + type(field_node_nc), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "field associated with " // label // " not found.") + + field = node%field +end function get_field_list_nc + + +!> Deallocate fields of list +subroutine finalize_field_list_nc(list) + class(field_list_nc), intent(inout) :: list + + type(field_node_nc), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_field_list_nc + + +!> Open a MOM framework file +subroutine open_file_infra(handle, filename, action, MOM_domain, threading, fileset) + class(MOM_infra_file), intent(inout) :: handle + character(len=*), intent(in) :: filename + integer, intent(in), optional :: action + type(MOM_domain_type), optional, intent(in) :: MOM_domain + integer, intent(in), optional :: threading + integer, intent(in), optional :: fileset + + call open_file(handle%handle_infra, filename, action=action, & + MOM_domain=MOM_domain, threading=threading, fileset=fileset) + + call handle%axes%init() + call handle%fields%init() +end subroutine open_file_infra + +!> Close a MOM framework file +subroutine close_file_infra(handle) + class(MOM_infra_file), intent(inout) :: handle + + call close_file(handle%handle_infra) + call handle%axes%finalize() + call handle%fields%finalize() +end subroutine close_file_infra + +!> Flush the buffer of a MOM framework file +subroutine flush_file_infra(handle) + class(MOM_infra_file), intent(in) :: handle + + call flush_file(handle%handle_infra) +end subroutine flush_file_infra + + +!> Register an axis to the MOM framework file +function register_axis_infra(handle, label, units, longname, & + cartesian, sense, domain, data, edge_axis, calendar) result(axis) + + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: label + !< The name in the file of this axis + character(len=*), intent(in) :: units + !< The units of this axis + character(len=*), intent(in) :: longname + !< The long description of this axis + character(len=*), optional, intent(in) :: cartesian + !< A variable indicating which direction this axis corresponds with. + !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer, optional, intent(in) :: sense + !< This is 1 for axes whose values increase upward, or -1 if they increase + !! downward. + type(domain1D), optional, intent(in) :: domain + !< The domain decomposion for this axis + real, dimension(:), optional, intent(in) :: data + !< The coordinate values of the points on this axis + logical, optional, intent(in) :: edge_axis + !< If true, this axis marks an edge of the tracer cells + character(len=*), optional, intent(in) :: calendar + !< The name of the calendar used with a time axis + type(MOM_axis) :: axis + !< The axis type where this information is stored + + type(axistype) :: ax_infra + + ! Create new infra axis and assign to pre-allocated tail of axes + call write_metadata(handle%handle_infra, ax_infra, label, units, longname, & + cartesian=cartesian, sense=sense, domain=domain, data=data, & + edge_axis=edge_axis, calendar=calendar) + + call handle%axes%append(ax_infra, label) + axis%label = label +end function register_axis_infra + + +!> Register a field to the MOM framework file +function register_field_infra(handle, axes, label, units, longname, pack, & + standard_name, checksum) result(field) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), dimension(:), intent(in) :: axes + !< Handles for the axis used for this variable + character(len=*), intent(in) :: label + !< The name in the file of this variable + character(len=*), intent(in) :: units + !< The units of this variable + character(len=*), intent(in) :: longname + !< The long description of this variable + integer, optional, intent(in) :: pack + !< A precision reduction factor with which the variable. The default, 1, + !! has no reduction, but 2 is not uncommon. + character(len=*), optional, intent(in) :: standard_name + !< The standard (e.g., CMOR) name for this variable + integer(kind=int64), dimension(:), optional, intent(in) :: checksum + !< Checksum values that can be used to verify reads. + type(MOM_field) :: field + !< The field type where this information is stored + + type(fieldtype) :: field_infra + type(axistype), allocatable :: field_axes(:) + integer :: i + + ! Construct array of framework axes + allocate(field_axes(size(axes))) + do i = 1, size(axes) + field_axes(i) = handle%axes%get(axes(i)%label) + enddo + + call write_metadata(handle%handle_infra, field_infra, field_axes, label, & + units, longname, pack=pack, standard_name=standard_name, checksum=checksum) + + call handle%fields%append(field_infra, label) + field%label = label +end function register_field_infra + + +!> Write a 4D field to the MOM framework file +subroutine write_field_4d_infra(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, MOM_domain, field, & + tstamp=tstamp, tile_count=tile_count, fill_value=fill_value) +end subroutine write_field_4d_infra + + +!> Write a 3D field to the MOM framework file +subroutine write_field_3d_infra(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, MOM_domain, field, & + tstamp=tstamp, tile_count=tile_count, fill_value=fill_value) +end subroutine write_field_3d_infra + + +!> Write a 2D field to the MOM framework file +subroutine write_field_2d_infra(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, MOM_domain, field, & + tstamp=tstamp, tile_count=tile_count, fill_value=fill_value) +end subroutine write_field_2d_infra + + +!> Write a 1D field to the MOM framework file +subroutine write_field_1d_infra(handle, field_md, field, tstamp) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, dimension(:), intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, field, tstamp=tstamp) +end subroutine write_field_1d_infra + + +!> Write a 0D field to the MOM framework file +subroutine write_field_0d_infra(handle, field_md, field, tstamp) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, field, tstamp=tstamp) +end subroutine write_field_0d_infra + + +!> Write an axis field to the MOM framework file +subroutine write_field_axis_infra(handle, axis) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axis + !< An axis type variable with information to write + + type(axistype) :: axis_infra + !< An axis type variable with information to write + + axis_infra = handle%axes%get(axis%label) + call write_field(handle%handle_infra, axis_infra) +end subroutine write_field_axis_infra + + +!> Write global metadata to the MOM framework file +subroutine write_attribute_infra(handle, name, attribute) + class(MOM_infra_file), intent(in) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: name + !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute + !< The value of this attribute + + call write_metadata(handle%handle_infra, name, attribute) +end subroutine write_attribute_infra + + +!> True if the framework file has been opened +logical function file_is_open_infra(handle) + class(MOM_infra_file), intent(in) :: handle + !< Handle to a file to inquire about + + file_is_open_infra = fms2_file_is_open(handle%handle_infra) +end function file_is_open_infra + + +!> Return number of dimensions, variables, or time levels in a MOM infra file +subroutine get_file_info_infra(handle, ndim, nvar, ntime) + class(MOM_infra_file), intent(in) :: handle + !< Handle for a file that is open for I/O + integer, optional, intent(out) :: ndim + !< The number of dimensions in the file + integer, optional, intent(out) :: nvar + !< The number of variables in the file + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + + call get_file_info(handle%handle_infra, ndim, nvar, ntime) +end subroutine get_file_info_infra + + +!> Return the field metadata associated with a MOM framework file +subroutine get_file_fields_infra(handle, fields) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), intent(inout) :: fields(:) + !< Field-type descriptions of all of the variables in a file. + + type(fieldtype), allocatable :: fields_infra(:) + integer :: i + character(len=64) :: label + + allocate(fields_infra(size(fields))) + call get_file_fields(handle%handle_infra, fields_infra) + + do i = 1, size(fields) + call get_field_atts(fields_infra(i), name=label) + call handle%fields%append(fields_infra(i), trim(label)) + fields(i)%label = trim(label) + enddo +end subroutine get_file_fields_infra + + +!> Get time levels of a MOM framework file +subroutine get_file_times_infra(handle, time_values, ntime) + class(MOM_infra_file), intent(in) :: handle + !< Handle for a file that is open for I/O + real, allocatable, dimension(:), intent(inout) :: time_values + !< The real times for the records in file. + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + + call get_file_times(handle%handle_infra, time_values, ntime=ntime) +end subroutine get_file_times_infra + + +!> Get attributes from a field +subroutine get_field_atts_infra(handle, field, name, units, longname, checksum) + class(MOM_infra_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field to extract information from + character(len=*), optional, intent(out) :: name + !< The variable name + character(len=*), optional, intent(out) :: units + !< The units of the variable + character(len=*), optional, intent(out) :: longname + !< The long name of the variable + integer(kind=int64), optional, intent(out) :: checksum(:) + !< The checksums of the variable in a file + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field%label) + call get_field_atts(field_infra, name, units, longname, checksum) +end subroutine get_field_atts_infra + + +!> Interface to read_field_chksum +subroutine read_field_chksum_infra(handle, field, chksum, valid_chksum) + class(MOM_infra_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field whose checksum attribute is to be read + integer(kind=int64), intent(out) :: chksum + !< The checksum for the field. + logical, intent(out) :: valid_chksum + !< If true, chksum has been successfully read + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field%label) + call read_field_chksum(field_infra, chksum, valid_chksum) +end subroutine read_field_chksum_infra + +!> Get the native (fieldtype) fields of a MOM framework file +subroutine get_file_fieldtypes(handle, fields) + class(MOM_infra_file), intent(in) :: handle + type(fieldtype), intent(out) :: fields(:) + + type(field_node_infra), pointer :: node + integer :: i + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => handle%fields%head + do i = 1, size(fields) + if (.not. associated(node%next)) & + call MOM_error(FATAL, 'fields(:) size exceeds number of registered fields.') + fields(i) = node%field + node => node%next + enddo +end subroutine get_file_fieldtypes + + +! MOM_netcdf_file methods + +!> Open a MOM netCDF file +subroutine open_file_nc(handle, filename, action, MOM_domain, threading, fileset) + class(MOM_netcdf_file), intent(inout) :: handle + character(len=*), intent(in) :: filename + integer, intent(in), optional :: action + type(MOM_domain_type), optional, intent(in) :: MOM_domain + integer, intent(in), optional :: threading + integer, intent(in), optional :: fileset + + if (.not. is_root_PE()) return + + call open_netcdf_file(handle%handle_nc, filename, action) + + handle%is_open = .true. + call handle%axes%init() + call handle%fields%init() +end subroutine open_file_nc + + +!> Close a MOM netCDF file +subroutine close_file_nc(handle) + class(MOM_netcdf_file), intent(inout) :: handle + + if (.not. is_root_PE()) return + + handle%is_open = .false. + call close_netcdf_file(handle%handle_nc) +end subroutine close_file_nc + + +!> Flush the buffer of a MOM netCDF file +subroutine flush_file_nc(handle) + class(MOM_netcdf_file), intent(in) :: handle + + if (.not. is_root_PE()) return + + call flush_netcdf_file(handle%handle_nc) +end subroutine flush_file_nc + + +!> Register an axis to the MOM netcdf file +function register_axis_nc(handle, label, units, longname, cartesian, sense, & + domain, data, edge_axis, calendar) result(axis) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a netCDF file that is open for writing + character(len=*), intent(in) :: label + !< The name in the file of this axis + character(len=*), intent(in) :: units + !< The units of this axis + character(len=*), intent(in) :: longname + !< The long description of this axis + character(len=*), optional, intent(in) :: cartesian + !< A variable indicating which direction this axis corresponds with. + !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer, optional, intent(in) :: sense + !< This is 1 for axes whose values increase upward, or -1 if they increase + !! downward. + type(domain1D), optional, intent(in) :: domain + !< The domain decomposion for this axis + real, dimension(:), optional, intent(in) :: data + !< The coordinate values of the points on this axis + logical, optional, intent(in) :: edge_axis + !< If true, this axis marks an edge of the tracer cells + character(len=*), optional, intent(in) :: calendar + !< The name of the calendar used with a time axis + type(MOM_axis) :: axis + + type(netcdf_axis) :: axis_nc + + if (is_root_PE()) then + axis_nc = register_netcdf_axis(handle%handle_nc, label, units, longname, & + data, cartesian, sense) + + call handle%axes%append(axis_nc, label) + endif + axis%label = label +end function register_axis_nc + + +!> Register a field to the MOM netcdf file +function register_field_nc(handle, axes, label, units, longname, pack, & + standard_name, checksum) result(field) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axes(:) + !< Handles for the axis used for this variable + character(len=*), intent(in) :: label + !< The name in the file of this variable + character(len=*), intent(in) :: units + !< The units of this variable + character(len=*), intent(in) :: longname + !< The long description of this variable + integer, optional, intent(in) :: pack + !< A precision reduction factor with which the variable. The default, 1, + !! has no reduction, but 2 is not uncommon. + character(len=*), optional, intent(in) :: standard_name + !< The standard (e.g., CMOR) name for this variable + integer(kind=int64), dimension(:), optional, intent(in) :: checksum + !< Checksum values that can be used to verify reads. + type(MOM_field) :: field + + type(netcdf_field) :: field_nc + type(netcdf_axis), allocatable :: axes_nc(:) + integer :: i + + if (is_root_PE()) then + allocate(axes_nc(size(axes))) + do i = 1, size(axes) + axes_nc(i) = handle%axes%get(axes(i)%label) + enddo + + field_nc = register_netcdf_field(handle%handle_nc, label, axes_nc, longname, units) + + call handle%fields%append(field_nc, label) + endif + field%label = label +end function register_field_nc + + +!> Write global metadata to the MOM netcdf file +subroutine write_attribute_nc(handle, name, attribute) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: name + !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute + !< The value of this attribute + + if (.not. is_root_PE()) return + + call write_netcdf_attribute(handle%handle_nc, name, attribute) +end subroutine write_attribute_nc + + +!> Write a 4D field to the MOM netcdf file +subroutine write_field_4d_nc(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_4d_nc + + +!> Write a 3D field to the MOM netcdf file +subroutine write_field_3d_nc(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_3d_nc + + +!> Write a 2D field to the MOM netcdf file +subroutine write_field_2d_nc(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_2d_nc + + +!> Write a 1D field to the MOM netcdf file +subroutine write_field_1d_nc(handle, field_md, field, tstamp) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, dimension(:), intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_1d_nc + + +!> Write a 0D field to the MOM netcdf file +subroutine write_field_0d_nc(handle, field_md, field, tstamp) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_0d_nc + + +!> Write an axis field to the MOM netcdf file +subroutine write_field_axis_nc(handle, axis) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axis + !< An axis type variable with information to write + + type(netcdf_axis) :: axis_nc + + if (.not. is_root_PE()) return + + axis_nc = handle%axes%get(axis%label) + call write_netcdf_axis(handle%handle_nc, axis_nc) +end subroutine write_field_axis_nc + + +!> True if the framework file has been opened +logical function file_is_open_nc(handle) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle to a file to inquire about + + file_is_open_nc = handle%is_open +end function file_is_open_nc + + +!> Return number of dimensions, variables, or time levels in a MOM netcdf file +subroutine get_file_info_nc(handle, ndim, nvar, ntime) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle for a file that is open for I/O + integer, optional, intent(out) :: ndim + !< The number of dimensions in the file + integer, optional, intent(out) :: nvar + !< The number of variables in the file + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + + integer :: ndim_nc, nvar_nc + + if (.not. is_root_PE()) return + + call get_netcdf_size(handle%handle_nc, ndims=ndim_nc, nvars=nvar_nc, nsteps=ntime) + + ! MOM I/O follows legacy FMS behavior and excludes axes from field count + if (present(ndim)) ndim = ndim_nc + if (present(nvar)) nvar = nvar_nc - ndim_nc +end subroutine get_file_info_nc + + +!> Return the field metadata associated with a MOM netCDF file +subroutine get_file_fields_nc(handle, fields) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), intent(inout) :: fields(:) + !< Field-type descriptions of all of the variables in a file. + + type(netcdf_axis), allocatable :: axes_nc(:) + type(netcdf_field), allocatable :: fields_nc(:) + integer :: i + + if (.not. is_root_PE()) return + + call get_netcdf_fields(handle%handle_nc, axes_nc, fields_nc) + if (size(fields) /= size(fields_nc)) & + call MOM_error(FATAL, 'Number of fields in file does not match field(:).') + + do i = 1, size(axes_nc) + call handle%axes%append(axes_nc(i), axes_nc(i)%label) + enddo + + do i = 1, size(fields) + fields(i)%label = trim(fields_nc(i)%label) + call handle%fields%append(fields_nc(i), fields_nc(i)%label) + enddo +end subroutine get_file_fields_nc + + +!> Get attributes from a netCDF field +subroutine get_field_atts_nc(handle, field, name, units, longname, checksum) + class(MOM_netcdf_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field to extract information from + character(len=*), optional, intent(out) :: name + !< The variable name + character(len=*), optional, intent(out) :: units + !< The units of the variable + character(len=*), optional, intent(out) :: longname + !< The long name of the variable + integer(kind=int64), optional, intent(out) :: checksum(:) + !< The checksums of the variable in a file + + call MOM_error(FATAL, 'get_field_atts over netCDF is not yet implemented.') +end subroutine get_field_atts_nc + + +!> Interface to read_field_chksum +subroutine read_field_chksum_nc(handle, field, chksum, valid_chksum) + class(MOM_netcdf_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field whose checksum attribute is to be read + integer(kind=int64), intent(out) :: chksum + !< The checksum for the field. + logical, intent(out) :: valid_chksum + !< If true, chksum has been successfully read + + call MOM_error(FATAL, 'read_field_chksum over netCDF is not yet implemented.') +end subroutine read_field_chksum_nc + + +!> \namespace MOM_IO_file +!! +!! This file defines the MOM_file classes used to inferface with the internal +!! IO handlers, such as the configured "infra" layer (FMS) or native netCDF. +!! +!! `MOM_file`: The generic class used to reference any file type +!! Cannot be used in a variable declaration. +!! +!! `MOM_infra_file`: A file handler for use by the infra layer. Currently this +!! means an FMS file, such a restart or diagnostic output. +!! +!! `MOM_netcdf_file`: A netCDF file handler for MOM-specific I/O. This may +!! include operations outside the scope of FMS or other infra frameworks. + +end module MOM_io_file diff --git a/src/framework/MOM_netcdf.F90 b/src/framework/MOM_netcdf.F90 new file mode 100644 index 0000000000..d09ae5cf95 --- /dev/null +++ b/src/framework/MOM_netcdf.F90 @@ -0,0 +1,755 @@ +!> MOM6 interface to netCDF operations +module MOM_netcdf + +! This file is part of MOM6. See LICENSE.md for the license. + +use, intrinsic :: iso_fortran_env, only : real32, real64 + +use netcdf, only : nf90_create, nf90_open, nf90_close +use netcdf, only : nf90_sync +use netcdf, only : NF90_CLOBBER, NF90_NOCLOBBER, NF90_WRITE, NF90_NOWRITE +use netcdf, only : nf90_enddef +use netcdf, only : nf90_def_dim, nf90_def_var +use netcdf, only : NF90_UNLIMITED +use netcdf, only : nf90_get_var +use netcdf, only : nf90_put_var, nf90_put_att +use netcdf, only : NF90_FLOAT, NF90_DOUBLE +use netcdf, only : nf90_strerror, NF90_NOERR +use netcdf, only : NF90_GLOBAL +use netcdf, only : nf90_inquire, nf90_inquire_dimension, nf90_inquire_variable +use netcdf, only : nf90_inq_dimids, nf90_inq_varids +use netcdf, only : NF90_MAX_NAME + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_io_infra, only : READONLY_FILE, WRITEONLY_FILE +use MOM_io_infra, only : APPEND_FILE, OVERWRITE_FILE + +implicit none ; private + +public :: netcdf_file_type +public :: netcdf_axis +public :: netcdf_field +public :: open_netcdf_file +public :: close_netcdf_file +public :: flush_netcdf_file +public :: register_netcdf_axis +public :: register_netcdf_field +public :: write_netcdf_field +public :: write_netcdf_axis +public :: write_netcdf_attribute +public :: get_netcdf_size +public :: get_netcdf_fields + + +!> Internal time value used to indicate an uninitialized time +real, parameter :: NULLTIME = -1 +! NOTE: For now, we use the FMS-compatible value, but may change in the future. + + +!> netCDF file abstraction +type :: netcdf_file_type + private + integer :: ncid + !< netCDF file ID + character(len=:), allocatable :: filename + !< netCDF filename + logical :: define_mode + !< True if file is in define mode. + integer :: time_id + !< Time axis variable ID + real :: time + !< Current model time + integer :: time_level + !< Current time level for output +end type netcdf_file_type + + +!> Dimension axis for a netCDF file +type :: netcdf_axis + private + character(len=:), allocatable, public :: label + !< Axis label name + real, allocatable :: points(:) + !< Grid points along the axis + integer :: dimid + !< netCDF dimension ID associated with axis + integer :: varid + !< netCDF variable ID associated with axis +end type netcdf_axis + + +!> Field variable for a netCDF file +type netcdf_field + private + character(len=:), allocatable, public :: label + !< Variable name + integer :: varid + !< netCDF variable ID for field +end type netcdf_field + + +!> Write values to a field of a netCDF file +interface write_netcdf_field + module procedure write_netcdf_field_4d + module procedure write_netcdf_field_3d + module procedure write_netcdf_field_2d + module procedure write_netcdf_field_1d + module procedure write_netcdf_field_0d +end interface write_netcdf_field + +contains + +subroutine open_netcdf_file(handle, filename, mode) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + character(len=*), intent(in) :: filename + !< netCDF filename + integer, intent(in), optional :: mode + !< Input MOM I/O mode + + integer :: io_mode + ! MOM I/O mode + integer :: cmode + ! netCDF creation mode + integer :: rc + ! nf90_create return code + character(len=:), allocatable :: msg + ! netCDF error message buffer + + ! I/O configuration + io_mode = WRITEONLY_FILE + if (present(mode)) io_mode = mode + + ! Translate the MOM I/O config to the netCDF mode + select case(io_mode) + case (WRITEONLY_FILE) + rc = nf90_create(filename, nf90_noclobber, handle%ncid) + handle%define_mode = .true. + case (OVERWRITE_FILE) + rc = nf90_create(filename, nf90_clobber, handle%ncid) + handle%define_mode = .true. + case (APPEND_FILE) + rc = nf90_open(filename, nf90_write, handle%ncid) + handle%define_mode = .false. + case (READONLY_FILE) + rc = nf90_open(filename, nf90_nowrite, handle%ncid) + handle%define_mode = .false. + case default + call MOM_error(FATAL, & + 'open_netcdf_file: File ' // filename // ': Unknown mode.') + end select + call check_netcdf_call(rc, 'open_netcdf_file', 'File ' // filename) + + handle%filename = filename + + ! FMS writes the filename as an attribute + call write_netcdf_attribute(handle, 'filename', filename) +end subroutine open_netcdf_file + + +!> Close an opened netCDF file. +subroutine close_netcdf_file(handle) + type(netcdf_file_type), intent(in) :: handle + + integer :: rc + + rc = nf90_close(handle%ncid) + call check_netcdf_call(rc, 'close_netcdf_file', & + 'File "' // handle%filename // '"') +end subroutine close_netcdf_file + + +!> Flush buffered output to the netCDF file +subroutine flush_netcdf_file(handle) + type(netcdf_file_type), intent(in) :: handle + + integer :: rc + + rc = nf90_sync(handle%ncid) + call check_netcdf_call(rc, 'flush_netcdf_file', & + 'File "' // handle%filename // '"') +end subroutine flush_netcdf_file + + +!> Change netCDF mode of handle from 'define' to 'write'. +subroutine enable_netcdf_write(handle) + type(netcdf_file_type), intent(inout) :: handle + + integer :: rc + + if (handle%define_mode) then + rc = nf90_enddef(handle%ncid) + call check_netcdf_call(rc, 'enable_netcdf_write', & + 'File "' // handle%filename // '"') + handle%define_mode = .false. + endif +end subroutine enable_netcdf_write + + +!> Register a netCDF variable +function register_netcdf_field(handle, label, axes, longname, units) & + result(field) + type(netcdf_file_type), intent(in) :: handle + !< netCDF file handle + character(len=*), intent(in) :: label + !< netCDF field name in the file + type(netcdf_axis), intent(in) :: axes(:) + !< Axes along which field is defined + character(len=*), intent(in) :: longname + !< Long name of the netCDF field + character(len=*), intent(in) :: units + !< Field units of measurement + type(netcdf_field) :: field + !< netCDF field + + integer :: rc + ! netCDF function return code + integer :: i + ! Loop index + integer, allocatable :: dimids(:) + ! netCDF dimension IDs of axes + integer :: xtype + ! netCDF data type + + ! Gather the axis netCDF dimension IDs + allocate(dimids(size(axes))) + dimids(:) = [(axes(i)%dimid, i = 1, size(axes))] + + ! Determine the corresponding netCDF data type + ! TODO: Support a `pack`-like argument + select case (kind(1.0)) + case (real32) + xtype = NF90_FLOAT + case (real64) + xtype = NF90_DOUBLE + case default + call MOM_error(FATAL, "register_netcdf_axis: Unknown kind(real).") + end select + + ! Register the field variable + rc = nf90_def_var(handle%ncid, label, xtype, dimids, field%varid) + call check_netcdf_call(rc, 'register_netcdf_field', & + 'File "' // handle%filename // '", Field "' // label // '"') + + ! Assign attributes + + rc = nf90_put_att(handle%ncid, field%varid, 'long_name', longname) + call check_netcdf_call(rc, 'register_netcdf_field', & + 'Attribute "long_name" of variable "' // label // '" in file "' & + // handle%filename // '"') + + rc = nf90_put_att(handle%ncid, field%varid, 'units', units) + call check_netcdf_call(rc, 'register_netcdf_field', & + 'Attribute "units" of variable "' // label // '" in file "' & + // handle%filename // '"') +end function register_netcdf_field + + +!> Create an axis and associated dimension in a netCDF file +function register_netcdf_axis(handle, label, units, longname, points, & + cartesian, sense) result(axis) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + character(len=*), intent(in) :: label + !< netCDF axis name in the file + character(len=*), intent(in), optional :: units + !< Axis units of measurement + character(len=*), intent(in), optional :: longname + !< Long name of the axis + real, intent(in), optional :: points(:) + !< Values of axis points (for fixed axes) + character(len=*), intent(in), optional :: cartesian + !< Character denoting axis direction: X, Y, Z, T, or N for none + integer, intent(in), optional :: sense + !< Axis direction; +1 if axis increases upward or -1 if downward + + type(netcdf_axis) :: axis + !< netCDF coordinate axis + + integer :: xtype + ! netCDF external data type + integer :: rc + ! netCDF function return code + logical :: unlimited + ! True if the axis is unlimited in size (e.g. time) + integer :: axis_size + ! Either the number of points in the axis, or unlimited flag + integer :: axis_sense + ! Axis direction; +1 if axis increases upward or -1 if downward + character(len=:), allocatable :: sense_attr + ! CF-compiant value of sense attribute (as 'positive') + + ! Create the axis dimension + unlimited = .false. + if (present(cartesian)) then + if (cartesian == 'T') unlimited = .true. + endif + + ! Either the axis is explicitly set with data or is declared as unlimited + if (present(points) .eqv. unlimited) then + call MOM_error(FATAL, & + "Axis must either have explicit points or be a time axis ('T').") + endif + + if (present(points)) then + axis_size = size(points) + allocate(axis%points(axis_size)) + axis%points(:) = points(:) + else + axis_size = NF90_UNLIMITED + endif + + rc = nf90_def_dim(handle%ncid, label, axis_size, axis%dimid) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Dimension "' // label // '" in file "' // handle%filename // '"') + + ! Determine the corresponding netCDF data type + ! TODO: Support a `pack`-like argument + select case (kind(1.0)) + case (real32) + xtype = NF90_FLOAT + case (real64) + xtype = NF90_DOUBLE + case default + call MOM_error(FATAL, "register_netcdf_axis: Unknown kind(real).") + end select + + ! Create a variable corresponding to the axis + rc = nf90_def_var(handle%ncid, label, xtype, axis%dimid, axis%varid) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Variable ' // label // ' in file ' // handle%filename) + + ! Define the time axis, if available + if (unlimited) then + handle%time_id = axis%varid + handle%time_level = 0 + handle%time = NULLTIME + endif + + ! Assign attributes if present + if (present(longname)) then + rc = nf90_put_att(handle%ncid, axis%varid, 'long_name', longname) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute ''long_name'' of variable ' // label // ' in file ' & + // handle%filename) + endif + + if (present(units)) then + rc = nf90_put_att(handle%ncid, axis%varid, 'units', units) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute ''units'' of variable ' // label // ' in file ' & + // handle%filename) + endif + + if (present(cartesian)) then + rc = nf90_put_att(handle%ncid, axis%varid, 'cartesian_axis', cartesian) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute ''cartesian_axis'' of variable ' // label // ' in file ' & + // handle%filename) + endif + + axis_sense = 0 + if (present(sense)) axis_sense = sense + + if (axis_sense /= 0) then + select case (axis_sense) + case (1) + sense_attr = 'up' + case (-1) + sense_attr = 'down' + case default + call MOM_error(FATAL, 'register_netcdf_axis: sense must be either ' & + // '0, 1, or -1.') + end select + rc = nf90_put_att(handle%ncid, axis%varid, 'positive', sense_attr) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute "positive" of variable "' // label // '" in file "' & + // handle%filename // '"') + endif +end function register_netcdf_axis + + +!> Write a 4D array to a compatible netCDF field +subroutine write_netcdf_field_4d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:,:,:,:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(5) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(:4) = 1 + start(5) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_4d + + +!> Write a 3D array to a compatible netCDF field +subroutine write_netcdf_field_3d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:,:,:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(4) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(:3) = 1 + start(4) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_3d + + +!> Write a 2D array to a compatible netCDF field +subroutine write_netcdf_field_2d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:,:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(3) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(:2) = 1 + start(3) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_2d + + +!> Write a 1D array to a compatible netCDF field +subroutine write_netcdf_field_1d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(2) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(1) = 1 + start(2) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_1d + + +!> Write a scalar to a compatible netCDF field +subroutine write_netcdf_field_0d(handle, field, scalar, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: scalar + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(1) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(1) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, scalar, start) + else + rc = nf90_put_var(handle%ncid, field%varid, scalar) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_0d + + +!> Write axis points to associated netCDF variable +subroutine write_netcdf_axis(handle, axis) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_axis), intent(in) :: axis + !< field variable + + integer :: rc + ! netCDF return code + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + rc = nf90_put_var(handle%ncid, axis%varid, axis%points) + call check_netcdf_call(rc, 'write_netcdf_axis', & + 'File "' // handle%filename // '", Axis "' // axis%label // '"') +end subroutine write_netcdf_axis + + +!> Write a global attribute to a netCDF file +subroutine write_netcdf_attribute(handle, label, attribute) + type(netcdf_file_type), intent(in) :: handle + !< netCDF file handle + character(len=*), intent(in) :: label + !< File attribute + character(len=*), intent(in) :: attribute + !< File attribute value + + integer :: rc + ! netCDF return code + + rc = nf90_put_att(handle%ncid, NF90_GLOBAL, label, attribute) + call check_netcdf_call(rc, 'write_netcdf_attribute', & + 'File "' // handle%filename // '", Attribute "' // label // '"') +end subroutine write_netcdf_attribute + + +! This is a thin interface to nf90_inquire, designed to mirror the existing +! I/O API. A more axis-aware system might not need this, but for now it's here +!> Get the number of dimensions, variables, and timesteps in a netCDF file +subroutine get_netcdf_size(handle, ndims, nvars, nsteps) + type(netcdf_file_type), intent(in) :: handle + !< netCDF input file + integer, intent(out), optional :: ndims + !< number of dimensions in the file + integer, intent(out), optional :: nvars + !< number of variables in the file + integer, intent(out), optional :: nsteps + !< number of values in the file's unlimited axis + + integer :: rc + ! netCDF return code + integer :: unlimited_dimid + ! netCDF dimension ID for unlimited time axis + + rc = nf90_inquire(handle%ncid, & + nDimensions=ndims, & + nVariables=nvars, & + unlimitedDimId=unlimited_dimid & + ) + call check_netcdf_call(rc, 'get_netcdf_size', & + 'File "' // handle%filename // '"') + + rc = nf90_inquire_dimension(handle%ncid, unlimited_dimid, len=nsteps) + call check_netcdf_call(rc, 'get_netcdf_size', & + 'File "' // handle%filename // '"') +end subroutine get_netcdf_size + + +!> Get the metadata of the registered fields in a netCDF file +subroutine get_netcdf_fields(handle, axes, fields) + type(netcdf_file_type), intent(inout) :: handle + type(netcdf_axis), intent(inout), allocatable :: axes(:) + type(netcdf_field), intent(inout), allocatable :: fields(:) + + integer :: ndims + ! Number of netCDF dimensions + integer :: nvars + ! Number of netCDF dimensions + integer :: nfields + ! Number of fields in the file (i.e. non-axis variables) + integer, allocatable :: dimids(:) + ! netCDF dimension IDs of file + integer, allocatable :: varids(:) + ! netCDF variable IDs of file + integer :: unlim_dimid + ! netCDF dimension ID for the unlimited axis variable, if present + integer :: unlim_index + ! Index of the unlimited axis in axes(:), if present + character(len=NF90_MAX_NAME) :: label + ! Current dimension or variable label + integer :: len + ! Current dimension length + integer :: rc + ! netCDF return code + integer :: grp_ndims, grp_nvars + ! Group-based counts for nf90_inq_* (unused) + logical :: is_axis + ! True if the current variable is an axis + integer :: i, j, n + + integer, save :: no_parent_groups = 0 + ! Flag indicating exclusion of parent groups in netCDF file + ! NOTE: This must be passed as a variable, and cannot be declared as a + ! parameter. + + rc = nf90_inquire(handle%ncid, & + nDimensions=ndims, & + nVariables=nvars, & + unlimitedDimId=unlim_dimid & + ) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + allocate(dimids(ndims)) + rc = nf90_inq_dimids(handle%ncid, grp_ndims, dimids, no_parent_groups) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + allocate(varids(nvars)) + rc = nf90_inq_varids(handle%ncid, grp_nvars, varids) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + allocate(axes(ndims)) + do i = 1, ndims + rc = nf90_inquire_dimension(handle%ncid, dimids(i), name=label, len=len) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + ! Check for the unlimited axis + if (dimids(i) == unlim_dimid) unlim_index = i + + axes(i)%dimid = dimids(i) + axes(i)%label = trim(label) + allocate(axes(i)%points(len)) + enddo + + nfields = nvars - ndims + allocate(fields(nfields)) + + n = 0 + do i = 1, nvars + rc = nf90_inquire_variable(handle%ncid, varids(i), name=label) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + ! Check if variable is an axis + is_axis = .false. + do j = 1, ndims + if (label == axes(j)%label) then + rc = nf90_get_var(handle%ncid, varids(i), axes(j)%points) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + axes(j)%varid = varids(i) + + if (j == unlim_index) then + handle%time_id = varids(i) + handle%time_level = size(axes(j)%points) + handle%time = NULLTIME + endif + + is_axis = .true. + exit + endif + enddo + if (is_axis) cycle + + n = n + 1 + fields(n)%label = trim(label) + fields(n)%varid = varids(i) + enddo +end subroutine get_netcdf_fields + + +subroutine update_netcdf_timestep(handle, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + real, intent(in) :: time + !< New model time + + integer :: start(1) + !< Time axis start index array + integer :: rc + !< netCDF return code + + if (time > handle%time + epsilon(time)) then + handle%time = time + handle%time_level = handle%time_level + 1 + + ! Write new value to time axis + start = [handle%time_level] + rc = nf90_put_var(handle%ncid, handle%time_id, time, start=start) + call check_netcdf_call(rc, 'update_netcdf_timestep', & + 'File "' // handle%filename // '"') + endif +end subroutine update_netcdf_timestep + + +!> Check netCDF function return codes, report the error log, and abort the run. +subroutine check_netcdf_call(ncerr, header, message) + integer, intent(in) :: ncerr + !< netCDF error code + character(len=*), intent(in) :: header + !< Message header (usually calling subroutine) + character(len=*), intent(in) :: message + !< Error message (usually action which instigated the error) + + character(len=:), allocatable :: errmsg + ! Full error message, including netCDF message + + if (ncerr /= nf90_noerr) then + errmsg = trim(header) // ": " // trim(message) // new_line('/') & + // trim(nf90_strerror(ncerr)) + call MOM_error(FATAL, errmsg) + endif +end subroutine check_netcdf_call + +end module MOM_netcdf diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index a76e96499f..2939a7d907 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -8,9 +8,9 @@ module MOM_restart use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_io, only : create_file, file_type, fieldtype, file_exists, open_file, close_file -use MOM_io, only : MOM_read_data, read_data, MOM_write_field, read_field_chksum, field_exists -use MOM_io, only : get_file_info, get_file_fields, get_field_atts, get_file_times +use MOM_io, only : create_MOM_file, file_exists +use MOM_io, only : MOM_infra_file, MOM_field +use MOM_io, only : MOM_read_data, read_data, MOM_write_field, field_exists use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix use MOM_io, only : MULTIPLE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE @@ -1258,7 +1258,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ ! Local variables type(vardesc) :: vars(CS%max_fields) ! Descriptions of the fields that ! are to be read from the restart file. - type(fieldtype) :: fields(CS%max_fields) ! Opaque types containing metadata describing + type(MOM_field) :: fields(CS%max_fields) ! Opaque types containing metadata describing ! each variable that will be written. character(len=512) :: restartpath ! The restart file path (dir/file). character(len=256) :: restartname ! The restart file name (no dir). @@ -1272,7 +1272,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ ! versions of NetCDF, the value was 2147483647_8. integer :: start_var, next_var ! The starting variables of the ! current and next files. - type(file_type) :: IO_handle ! The I/O handle of the open fileset + type(MOM_infra_file) :: IO_handle ! The I/O handle of the open fileset integer :: m, nz integer :: num_files ! The number of restart files that will be used. integer :: seconds, days, year, month, hour, minute @@ -1408,11 +1408,11 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ enddo if (CS%parallel_restartfiles) then - call create_file(IO_handle, trim(restartpath), vars, (next_var-start_var), & - fields, MULTIPLE, G=G, GV=GV, checksums=check_val) + call create_MOM_file(IO_handle, trim(restartpath), vars, next_var-start_var, & + fields, MULTIPLE, G=G, GV=GV, checksums=check_val) else - call create_file(IO_handle, trim(restartpath), vars, (next_var-start_var), & - fields, SINGLE_FILE, G=G, GV=GV, checksums=check_val) + call create_MOM_file(IO_handle, trim(restartpath), vars, next_var-start_var, & + fields, SINGLE_FILE, G=G, GV=GV, checksums=check_val) endif do m=start_var,next_var-1 @@ -1434,7 +1434,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ endif enddo - call close_file(IO_handle) + call IO_handle%close() num_files = num_files+1 @@ -1466,14 +1466,14 @@ subroutine restore_state(filename, directory, day, G, CS) integer :: isL, ieL, jsL, jeL integer :: nvar, ntime, pos - type(file_type) :: IO_handles(CS%max_fields) ! The I/O units of all open files. + type(MOM_infra_file) :: IO_handles(CS%max_fields) ! The I/O units of all open files. character(len=200) :: unit_path(CS%max_fields) ! The file names. logical :: unit_is_global(CS%max_fields) ! True if the file is global. character(len=8) :: hor_grid ! Variable grid info. real :: t1, t2 ! Two times. real, allocatable :: time_vals(:) - type(fieldtype), allocatable :: fields(:) + type(MOM_field), allocatable :: fields(:) logical :: is_there_a_checksum ! Is there a valid checksum that should be checked. integer(kind=8) :: checksum_file ! The checksum value recorded in the input file. integer(kind=8) :: checksum_data ! The checksum value for the data that was read in. @@ -1500,7 +1500,7 @@ subroutine restore_state(filename, directory, day, G, CS) ! Get the time from the first file in the list that has one. do n=1,num_file - call get_file_times(IO_handles(n), time_vals, ntime) + call IO_handles(n)%get_file_times(time_vals, ntime) if (ntime < 1) cycle t1 = time_vals(1) @@ -1516,7 +1516,7 @@ subroutine restore_state(filename, directory, day, G, CS) ! Check the remaining files for different times and issue a warning ! if they differ from the first time. do m = n+1,num_file - call get_file_times(IO_handles(n), time_vals, ntime) + call IO_handles(n)%get_file_times(time_vals, ntime) if (ntime < 1) cycle t2 = time_vals(1) @@ -1532,13 +1532,13 @@ subroutine restore_state(filename, directory, day, G, CS) ! Read each variable from the first file in which it is found. do n=1,num_file - call get_file_info(IO_handles(n), nvar=nvar) + call IO_handles(n)%get_file_info(nvar=nvar) allocate(fields(nvar)) - call get_file_fields(IO_handles(n), fields(1:nvar)) + call IO_handles(n)%get_file_fields(fields(1:nvar)) do m=1, nvar - call get_field_atts(fields(m), name=varname) + call IO_handles(n)%get_field_atts(fields(m), name=varname) do i=1,CS%num_obsolete_vars if (adjustl(lowercase(trim(varname))) == adjustl(lowercase(trim(CS%restart_obsolete(i)%field_name)))) then call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& @@ -1571,11 +1571,11 @@ subroutine restore_state(filename, directory, day, G, CS) call get_checksum_loop_ranges(G, pos, isL, ieL, jsL, jeL) do i=1, nvar - call get_field_atts(fields(i), name=varname) + call IO_handles(n)%get_field_atts(fields(i), name=varname) if (lowercase(trim(varname)) == lowercase(trim(CS%restart_field(m)%var_name))) then checksum_data = -1 if (CS%checksum_required) then - call read_field_chksum(fields(i), checksum_file, is_there_a_checksum) + call IO_handles(n)%read_field_chksum(fields(i), checksum_file, is_there_a_checksum) else checksum_file = -1 is_there_a_checksum = .false. ! Do not need to do data checksumming. @@ -1643,7 +1643,7 @@ subroutine restore_state(filename, directory, day, G, CS) enddo do n=1,num_file - call close_file(IO_handles(n)) + call IO_handles(n)%close() enddo ! Check whether any mandatory fields have not been found. @@ -1745,7 +1745,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct - type(file_type), dimension(:), & + type(MOM_infra_file), dimension(:), & optional, intent(out) :: IO_handles !< The I/O handles of all opened files character(len=*), dimension(:), & optional, intent(out) :: file_paths !< The full paths to open files @@ -1822,7 +1822,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (fexists) then nf = nf + 1 if (present(IO_handles)) & - call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, & + call IO_handles(nf)%open(trim(filepath), READONLY_FILE, & threading=MULTIPLE, fileset=SINGLE_FILE) if (present(global_files)) global_files(nf) = .true. if (present(file_paths)) file_paths(nf) = filepath @@ -1832,7 +1832,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (fexists) then nf = nf + 1 if (present(IO_handles)) & - call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, MOM_domain=G%Domain) + call IO_handles(nf)%open(trim(filepath), READONLY_FILE, MOM_domain=G%Domain) if (present(global_files)) global_files(nf) = .false. if (present(file_paths)) file_paths(nf) = filepath endif @@ -1854,7 +1854,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (fexists) then nf = nf + 1 if (present(IO_handles)) & - call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, & + call IO_handles(nf)%open(trim(filepath), READONLY_FILE, & threading=MULTIPLE, fileset=SINGLE_FILE) if (present(global_files)) global_files(nf) = .true. if (present(file_paths)) file_paths(nf) = filepath diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index aaa53dee59..a78c17803c 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -33,7 +33,7 @@ module MOM_ice_shelf use user_initialization, only : user_initialize_topography use MOM_io, only : field_exists, file_exists, MOM_read_data, write_version_number use MOM_io, only : slasher, fieldtype, vardesc, var_desc -use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE +use MOM_io, only : close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS, register_restart_pair use MOM_time_manager, only : time_type, time_type_to_real, real_to_time, operator(>), operator(-) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index c956c6b4be..78f739c461 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -8,7 +8,8 @@ module MOM_coord_initialization use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type, log_version -use MOM_io, only : close_file, create_file, file_type, fieldtype, file_exists +use MOM_io, only : create_MOM_file, file_exists +use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, MOM_write_field, vardesc, var_desc, SINGLE_FILE use MOM_string_functions, only : slasher, uppercase use MOM_unit_scaling, only : unit_scale_type @@ -526,20 +527,21 @@ subroutine write_vertgrid_file(GV, US, param_file, directory) ! Local variables character(len=240) :: filepath type(vardesc) :: vars(2) - type(fieldtype) :: fields(2) - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_field) :: fields(2) + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset filepath = trim(directory) // trim("Vertical_coordinate") vars(1) = var_desc("R","kilogram meter-3","Target Potential Density",'1','L','1') vars(2) = var_desc("g","meter second-2","Reduced gravity",'1','L','1') - call create_file(IO_handle, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) + call create_MOM_file(IO_handle, trim(filepath), vars, 2, fields, & + SINGLE_FILE, GV=GV) call MOM_write_field(IO_handle, fields(1), GV%Rlay, scale=US%R_to_kg_m3) call MOM_write_field(IO_handle, fields(2), GV%g_prime, scale=US%L_T_to_m_s**2*US%m_to_Z) - call close_file(IO_handle) + call IO_handle%close() end subroutine write_vertgrid_file diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index acffc9c927..2981bb9e94 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -11,7 +11,8 @@ module MOM_shared_initialization use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, log_param, param_file_type, log_version -use MOM_io, only : close_file, create_file, file_type, fieldtype, file_exists, field_size +use MOM_io, only : create_MOM_file, file_exists, field_size +use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, MOM_read_vector, read_variable, stdout use MOM_io, only : open_file_to_read, close_file_to_read, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, MOM_write_field, var_desc @@ -1346,9 +1347,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) character(len=40) :: mdl = "write_ocean_geometry_file" type(vardesc), dimension(:), allocatable :: & vars ! Types with metadata about the variables and their staggering - type(fieldtype), dimension(:), allocatable :: & + type(MOM_field), dimension(:), allocatable :: & fields ! Opaque types used by MOM_io to store variable metadata information - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset integer :: nFlds ! The number of variables in this file integer :: file_threading logical :: multiple_files @@ -1412,7 +1413,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) file_threading = SINGLE_FILE if (multiple_files) file_threading = MULTIPLE - call create_file(IO_handle, trim(filepath), vars, nFlds, fields, file_threading, dG=G) + call create_MOM_file(IO_handle, trim(filepath), vars, nFlds, fields, & + file_threading, dG=G) call MOM_write_field(IO_handle, fields(1), G%Domain, G%geoLatBu) call MOM_write_field(IO_handle, fields(2), G%Domain, G%geoLonBu) @@ -1445,7 +1447,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=US%Z_to_m) endif - call close_file(IO_handle) + call IO_handle%close() deallocate(vars, fields) From b7e5b338ad429f904a27dcbe0cc20d307e79e57a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 13 Jan 2023 10:16:44 -0500 Subject: [PATCH 140/213] pipeline: compile preproc executables on login nodes In order to adapt pipelines to work from a read-only NFS space we need the pre-processing step for tc4 to be [optionally] broken into two steps: a compile step and a data generation step. Changes: - Added the target "executables to tc4/Makefile, so only compilation occurs when invoked. The "all" target still compiles if needed. - Added target "preproc-compile" to .testing/Makefile whcih invokes the "executables" target of tc4/Makefile. The target "preproc" still compiles if needed. - Added `make-preproc-compile` to the gitlab pipeline prior to submitting the "make test" job to the compute nodes. - I also disconnected the "clean.stats" target from "clean.preproc" since the latter removes the pre-processing executables too and given that we can't re-compile those and re-create the stats from the same location it makes sense to keep those clean steps separated. --- .gitlab-ci.yml | 2 ++ .testing/Makefile | 4 +++- .testing/tc4/Makefile.in | 1 + 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fbc2854b33..6291d2bd84 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -182,6 +182,7 @@ actions:gnu: - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan ; module load PrgEnv-gnu ; module unload netcdf gcc ; module load gcc/7.3.0 cray-hdf5 cray-netcdf - make -s -j + - make preproc-compile -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) @@ -201,6 +202,7 @@ actions:intel: - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan; module load PrgEnv-intel; module unload netcdf intel; module load intel/18.0.6.288 cray-hdf5 cray-netcdf - make -s -j + - make preproc-compile -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) diff --git a/.testing/Makefile b/.testing/Makefile index 73a97229d4..0b9c57f675 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -523,6 +523,8 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) .PHONY: preproc preproc: tc4/Makefile cd tc4 && $(MAKE) LAUNCHER="$(MPIRUN)" +preproc-compile: tc4/Makefile + cd tc4 && $(MAKE) executables tc4/Makefile: tc4/configure tc4/Makefile.in cd $(@D) && ./configure || (cat config.log && false) @@ -795,7 +797,7 @@ clean.build: .PHONY: clean.stats -clean.stats: clean.preproc +clean.stats: @[ $$(basename $$(pwd)) = .testing ] rm -rf work results diff --git a/.testing/tc4/Makefile.in b/.testing/tc4/Makefile.in index 5a0e441482..714a8f19f1 100644 --- a/.testing/tc4/Makefile.in +++ b/.testing/tc4/Makefile.in @@ -16,6 +16,7 @@ OUT = ocean_hgrid.nc topog.nc temp_salt_ic.nc sponge.nc # Program output all: ocean_hgrid.nc temp_salt_ic.nc +executables: gen_data gen_grid ocean_hgrid.nc: gen_grid $(LAUNCHER) ./gen_grid From 86c39546fbbd3df4947b8faba26ca08d95653bd3 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 13 Jan 2023 11:10:36 -0500 Subject: [PATCH 141/213] .testing: Add WORKSPACE cpp macro to control scratch space - Added CPP macro "WORKSPACE" which defaults to ".". This controls where the work/ and results/ directories are located as used by the target "test" in .testing/Makefile. - Use WORKSPACE=/lustre/f2/scratch/$USER/runner/$CI_RUNNER_ID in the job script so that if the runner is later moved to a read-only-from-compute disk the pipeline still works. --- .gitlab-ci.yml | 8 +-- .testing/Makefile | 124 ++++++++++++++++++++++++---------------------- 2 files changed, 69 insertions(+), 63 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6291d2bd84..3efce5170a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -182,9 +182,9 @@ actions:gnu: - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan ; module load PrgEnv-gnu ; module unload netcdf gcc ; module load gcc/7.3.0 cray-hdf5 cray-netcdf - make -s -j - - make preproc-compile -s -j + - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=/lustre/f2/scratch/$USER/runner/$CI_RUNNER_ID test -s -j') > job.sh - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) - make test.summary @@ -202,9 +202,9 @@ actions:intel: - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan; module load PrgEnv-intel; module unload netcdf intel; module load intel/18.0.6.288 cray-hdf5 cray-netcdf - make -s -j - - make preproc-compile -s -j + - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=/lustre/f2/scratch/$USER/runner/$CI_RUNNER_ID test -s -j') > job.sh - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) - make test.summary diff --git a/.testing/Makefile b/.testing/Makefile index 0b9c57f675..8a79d86e0a 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -57,6 +57,9 @@ # MOM_TARGET_LOCAL_BRANCH Target branch name # (NOTE: These would typically be configured by a CI.) # +# Paths for stages: +# WORKSPACE Location to place work/ and results/ directories (i.e. where to run the model) +# #---- # TODO: POSIX shell compatibility @@ -129,6 +132,8 @@ CONFIGS ?= $(wildcard tc*) TESTS ?= grid layout rotate restart openmp nan $(foreach d,$(DIMS),dim.$(d)) DIMS ?= t l h z q r +# Default is to place work/ and results/ in current directory +WORKSPACE ?= . #--- # Test configuration @@ -408,11 +413,11 @@ endef $(foreach d,$(DIMS),$(eval $(call TEST_DIM_RULE,$(d)))) .PHONY: run.symmetric run.asymmetric run.nans run.openmp run.cov -run.symmetric: $(foreach c,$(CONFIGS),work/$(c)/symmetric/ocean.stats) -run.asymmetric: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(CONFIGS),work/$(c)/asymmetric/ocean.stats) -run.nan: $(foreach c,$(CONFIGS),work/$(c)/nan/ocean.stats) -run.openmp: $(foreach c,$(CONFIGS),work/$(c)/openmp/ocean.stats) -run.cov: $(foreach c,$(CONFIGS),work/$(c)/cov/ocean.stats) +run.symmetric: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/symmetric/ocean.stats) +run.asymmetric: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(CONFIGS),$(WORKSPACE)/work/$(c)/asymmetric/ocean.stats) +run.nan: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/nan/ocean.stats) +run.openmp: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/openmp/ocean.stats) +run.cov: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/cov/ocean.stats) # Configuration test rules # $(1): Configuration name (tc1, tc2, &c.) @@ -444,21 +449,21 @@ FAIL = ${RED}FAIL${RESET} # $(2): Test type (grid, layout, &c.) # $(3): Comparison targets (symmetric asymmetric, symmetric layout, &c.) define CMP_RULE -.PRECIOUS: $(foreach b,$(3),work/$(1)/$(b)/ocean.stats) -$(1).$(2): $(foreach b,$(3),work/$(1)/$(b)/ocean.stats) - @test "$$(shell ls -A results/$(1) 2>/dev/null)" || rm -rf results/$(1) +.PRECIOUS: $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/ocean.stats) +$(1).$(2): $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/ocean.stats) + @test "$$(shell ls -A $(WORKSPACE)/results/$(1) 2>/dev/null)" || rm -rf $(WORKSPACE)/results/$(1) @cmp $$^ || !( \ - mkdir -p results/$(1); \ - (diff $$^ | tee results/$(1)/ocean.stats.$(2).diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$(1); \ + (diff $$^ | tee $(WORKSPACE)/results/$(1)/ocean.stats.$(2).diff | head -n 20) ; \ echo -e "$(FAIL): Solutions $(1).$(2) have changed." \ ) @echo -e "$(PASS): Solutions $(1).$(2) agree." -.PRECIOUS: $(foreach b,$(3),work/$(1)/$(b)/chksum_diag) -$(1).$(2).diag: $(foreach b,$(3),work/$(1)/$(b)/chksum_diag) +.PRECIOUS: $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/chksum_diag) +$(1).$(2).diag: $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/chksum_diag) @cmp $$^ || !( \ - mkdir -p results/$(1); \ - (diff $$^ | tee results/$(1)/chksum_diag.$(2).diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$(1); \ + (diff $$^ | tee $(WORKSPACE)/results/$(1)/chksum_diag.$(2).diff | head -n 20) ; \ echo -e "$(FAIL): Diagnostics $(1).$(2).diag have changed." \ ) @echo -e "$(PASS): Diagnostics $(1).$(2).diag agree." @@ -478,14 +483,15 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # Custom comparison rules + # Restart tests only compare the final stat record -.PRECIOUS: $(foreach b,symmetric restart target,work/%/$(b)/ocean.stats) -%.restart: $(foreach b,symmetric restart,work/%/$(b)/ocean.stats) - @test "$(shell ls -A results/$* 2>/dev/null)" || rm -rf results/$* +.PRECIOUS: $(foreach b,symmetric restart target,$(WORKSPACE)/work/%/$(b)/ocean.stats) +%.restart: $(foreach b,symmetric restart,$(WORKSPACE)/work/%/$(b)/ocean.stats) + @test "$(shell ls -A $(WORKSPACE)/results/$* 2>/dev/null)" || rm -rf $(WORKSPACE)/results/$* @cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) \ || !( \ - mkdir -p results/$*; \ - (diff $^ | tee results/$*/chksum_diag.restart.diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$*; \ + (diff $^ | tee $(WORKSPACE)/results/$*/chksum_diag.restart.diff | head -n 20) ; \ echo -e "$(FAIL): Solutions $*.restart have changed." \ ) @echo -e "$(PASS): Solutions $*.restart agree." @@ -493,21 +499,21 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # TODO: chksum_diag parsing of restart files # stats rule is unchanged, but we cannot use CMP_RULE to generate it. -%.regression: $(foreach b,symmetric target,work/%/$(b)/ocean.stats) - @test "$(shell ls -A results/$* 2>/dev/null)" || rm -rf results/$* +%.regression: $(foreach b,symmetric target,$(WORKSPACE)/work/%/$(b)/ocean.stats) + @test "$(shell ls -A $(WORKSPACE)/results/$* 2>/dev/null)" || rm -rf $(WORKSPACE)/results/$* @cmp $^ || !( \ - mkdir -p results/$*; \ - (diff $^ | tee results/$*/ocean.stats.regression.diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$*; \ + (diff $^ | tee $(WORKSPACE)/results/$*/ocean.stats.regression.diff | head -n 20) ; \ echo -e "$(FAIL): Solutions $*.regression have changed." \ ) @echo -e "$(PASS): Solutions $*.regression agree." # Regression testing only checks for changes in existing diagnostics -%.regression.diag: $(foreach b,symmetric target,work/%/$(b)/chksum_diag) +%.regression.diag: $(foreach b,symmetric target,$(WORKSPACE)/work/%/$(b)/chksum_diag) @! diff $^ | grep "^[<>]" | grep "^>" > /dev/null \ || ! (\ - mkdir -p results/$*; \ - (diff $^ | tee results/$*/chksum_diag.regression.diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$*; \ + (diff $^ | tee $(WORKSPACE)/results/$*/chksum_diag.regression.diff | head -n 20) ; \ echo -e "$(FAIL): Diagnostics $*.regression.diag have changed." \ ) @cmp $^ || ( \ @@ -536,7 +542,7 @@ tc4/configure: tc4/configure.ac #--- # Test run output files -# Rule to build work//{ocean.stats,chksum_diag}. +# Rule to build $(WORKSPACE)/work//{ocean.stats,chksum_diag}. # $(1): Test configuration name # $(2): Executable type # $(3): Enable coverage flag @@ -545,15 +551,15 @@ tc4/configure: tc4/configure.ac # $(6): Number of MPI ranks define STAT_RULE -work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 | preproc +$(WORKSPACE)/work/%/$(1)/ocean.stats $(WORKSPACE)/work/%/$(1)/chksum_diag: build/$(2)/MOM6 | preproc @echo "Running test $$*.$(1)..." mkdir -p $$(@D) cp -RL $$*/* $$(@D) mkdir -p $$(@D)/RESTART echo -e "$(4)" > $$(@D)/MOM_override - rm -f results/$$*/std.$(1).{out,err} + rm -f $(WORKSPACE)/results/$$*/std.$(1).{out,err} cd $$(@D) \ - && $(TIME) $(5) $(MPIRUN) -n $(6) ../../../$$< 2> std.err > std.out \ + && $(TIME) $(5) $(MPIRUN) -n $(6) $(abspath $$<) 2> std.err > std.out \ || !( \ mkdir -p ../../../results/$$*/ ; \ cat std.out | tee ../../../results/$$*/std.$(1).out | tail -n 20 ; \ @@ -563,7 +569,7 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 | preproc ) @echo -e "$(DONE): $$*.$(1); no runtime errors." if [ $(3) ]; then \ - mkdir -p results/$$* ; \ + mkdir -p $(WORKSPACE)/results/$$* ; \ cd build/$(2) ; \ gcov -b *.gcda > gcov.$$*.$(1).out ; \ find -name "*.gcov" -exec sed -i -r 's/^( *[0-9]*)\*:/ \1:/g' {} \; ; \ @@ -614,7 +620,7 @@ $(eval $(call STAT_RULE,cov,cov,true,,,1)) # 2. Convert DAYMAX from TIMEUNIT to seconds # 3. Apply seconds to `ocean_solo_nml` inside input.nml. # NOTE: Assumes that runtime set by DAYMAX, will fail if set by input.nml -work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc +$(WORKSPACE)/work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc rm -rf $(@D) mkdir -p $(@D) cp -RL $*/* $(@D) @@ -628,9 +634,9 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc && halfperiod=$$(awk -v t=$${daymax} -v dt=$${timeunit} 'BEGIN {printf "%.f", 0.5*t*dt}') \ && printf "\n&ocean_solo_nml\n seconds = $${halfperiod}\n/\n" >> input.nml # Remove any previous archived output - rm -f results/$*/std.restart{1,2}.{out,err} + rm -f $(WORKSPACE)/results/$*/std.restart{1,2}.{out,err} # Run the first half-period - cd $(@D) && $(TIME) $(MPIRUN) -n 1 ../../../$< 2> std1.err > std1.out \ + cd $(@D) && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std1.err > std1.out \ || !( \ cat std1.out | tee ../../../results/$*/std.restart1.out | tail -n 20 ; \ cat std1.err | tee ../../../results/$*/std.restart1.err | tail -n 20 ; \ @@ -641,7 +647,7 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc mkdir $(@D)/RESTART cd $(@D) && sed -i -e "s/input_filename *= *'n'/input_filename = 'r'/g" input.nml # Run the second half-period - cd $(@D) && $(TIME) $(MPIRUN) -n 1 ../../../$< 2> std2.err > std2.out \ + cd $(@D) && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std2.err > std2.out \ || !( \ cat std2.out | tee ../../../results/$*/std.restart2.out | tail -n 20 ; \ cat std2.err | tee ../../../results/$*/std.restart2.err | tail -n 20 ; \ @@ -654,20 +660,20 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc # Not a true rule; only call this after `make test` to summarize test results. .PHONY: test.summary test.summary: - @if ls results/*/* &> /dev/null; then \ - if ls results/*/std.*.err &> /dev/null; then \ + @if ls $(WORKSPACE)/results/*/* &> /dev/null; then \ + if ls $(WORKSPACE)/results/*/std.*.err &> /dev/null; then \ echo "The following tests failed to complete:" ; \ - ls results/*/std.*.out \ + ls $(WORKSPACE)/results/*/std.*.out \ | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[2]; if(length(t)>3) v=v"."t[3]; print a[2],":",v}'; \ fi; \ - if ls results/*/ocean.stats.*.diff &> /dev/null; then \ + if ls $(WORKSPACE)/results/*/ocean.stats.*.diff &> /dev/null; then \ echo "The following tests report solution regressions:" ; \ - ls results/*/ocean.stats.*.diff \ + ls $(WORKSPACE)/results/*/ocean.stats.*.diff \ | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[3]; if(length(t)>4) v=v"."t[4]; print a[2],":",v}'; \ fi; \ - if ls results/*/chksum_diag.*.diff &> /dev/null; then \ + if ls $(WORKSPACE)/results/*/chksum_diag.*.diff &> /dev/null; then \ echo "The following tests report diagnostic regressions:" ; \ - ls results/*/chksum_diag.*.diff \ + ls $(WORKSPACE)/results/*/chksum_diag.*.diff \ | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[2]; if(length(t)>3) v=v"."t[3]; print a[2],":",v}'; \ fi; \ false ; \ @@ -683,28 +689,28 @@ test.summary: .PHONY: run.cov.unit run.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov -work/unit/std.out: build/unit/MOM_unit_tests +$(WORKSPACE)/work/unit/std.out: build/unit/MOM_unit_tests if [ $(REPORT_COVERAGE) ]; then \ find build/unit -name *.gcda -exec rm -f '{}' \; ; \ fi rm -rf $(@D) mkdir -p $(@D) cd $(@D) \ - && $(TIME) $(MPIRUN) -n 1 ../../$< 2> std.err > std.out \ + && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std.err > std.out \ || !( \ cat std.out | tail -n 100 ; \ cat std.err | tail -n 100 ; \ ) cd $(@D) \ - && $(TIME) $(MPIRUN) -n 2 ../../$< 2> p2.std.err > p2.std.out \ + && $(TIME) $(MPIRUN) -n 2 $(abspath $<) 2> p2.std.err > p2.std.out \ || !( \ cat p2.std.out | tail -n 100 ; \ cat p2.std.err | tail -n 100 ; \ ) # NOTE: .gcov actually depends on .gcda, but .gcda is produced with std.out -# TODO: Replace work/unit/std.out with *.gcda? -build/unit/MOM_file_parser_tests.F90.gcov: work/unit/std.out +# TODO: Replace $(WORKSPACE)/work/unit/std.out with *.gcda? +build/unit/MOM_file_parser_tests.F90.gcov: $(WORKSPACE)/work/unit/std.out cd $(@D) \ && gcov -b *.gcda > gcov.unit.out find $(@D) -name "*.gcov" -exec sed -i -r 's/^( *[0-9]*)\*:/ \1:/g' {} \; @@ -731,22 +737,22 @@ PCONFIGS = p0 profile: $(foreach p,$(PCONFIGS), prof.$(p)) .PHONY: prof.p0 -prof.p0: work/p0/opt/clocks.json work/p0/opt_target/clocks.json +prof.p0: $(WORKSPACE)/work/p0/opt/clocks.json $(WORKSPACE)/work/p0/opt_target/clocks.json python tools/compare_clocks.py $^ -work/p0/%/clocks.json: work/p0/%/std.out +$(WORKSPACE)/work/p0/%/clocks.json: $(WORKSPACE)/work/p0/%/std.out python tools/parse_fms_clocks.py -d $(@D) $^ > $@ -work/p0/opt/std.out: build/opt/MOM6 -work/p0/opt_target/std.out: build/opt_target/MOM6 +$(WORKSPACE)/work/p0/opt/std.out: build/opt/MOM6 +$(WORKSPACE)/work/p0/opt_target/std.out: build/opt_target/MOM6 -work/p0/%/std.out: +$(WORKSPACE)/work/p0/%/std.out: mkdir -p $(@D) cp -RL p0/* $(@D) mkdir -p $(@D)/RESTART echo -e "" > $(@D)/MOM_override cd $(@D) \ - && $(MPIRUN) -n 1 ../../../$< 2> std.err > std.out + && $(MPIRUN) -n 1 $(abspath $<) 2> std.err > std.out #--- @@ -759,16 +765,16 @@ PERF_EVENTS ?= perf: $(foreach p,$(PCONFIGS), perf.$(p)) .PHONY: prof.p0 -perf.p0: work/p0/opt/profile.json work/p0/opt_target/profile.json +perf.p0: $(WORKSPACE)/work/p0/opt/profile.json $(WORKSPACE)/work/p0/opt_target/profile.json python tools/compare_perf.py $^ -work/p0/%/profile.json: work/p0/%/perf.data +$(WORKSPACE)/work/p0/%/profile.json: $(WORKSPACE)/work/p0/%/perf.data python tools/parse_perf.py -f $< > $@ -work/p0/opt/perf.data: build/opt/MOM6 -work/p0/opt_target/perf.data: build/opt_target/MOM6 +$(WORKSPACE)/work/p0/opt/perf.data: build/opt/MOM6 +$(WORKSPACE)/work/p0/opt_target/perf.data: build/opt_target/MOM6 -work/p0/%/perf.data: +$(WORKSPACE)/work/p0/%/perf.data: mkdir -p $(@D) cp -RL p0/* $(@D) mkdir -p $(@D)/RESTART @@ -799,7 +805,7 @@ clean.build: .PHONY: clean.stats clean.stats: @[ $$(basename $$(pwd)) = .testing ] - rm -rf work results + rm -rf $(WORKSPACE)/work $(WORKSPACE)/results .PHONY: clean.preproc From 1fe52f70e0a8b43b7447d1a25af7320d343ed51b Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 13 Jan 2023 12:08:00 -0500 Subject: [PATCH 142/213] pipeline: Show list of PASSes Purely asesthetic Purely aesthetic change, but on success, it's nice to see the long list of green checks. Previously we only showed any detail on a fail and on success show the one line summary. --- .gitlab-ci.yml | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3efce5170a..0462e3aa7a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -10,6 +10,7 @@ stages: # We use the "fetch" strategy to speed up the startup of stages variables: JOB_DIR: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/builds/$CI_PIPELINE_ID" + WORKSPACE: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/$CI_RUNNER_ID" GIT_STRATEGY: fetch # Always eport value of $JOB_DIR @@ -184,9 +185,9 @@ actions:gnu: - make -s -j - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=/lustre/f2/scratch/$USER/runner/$CI_RUNNER_ID test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) - - make test.summary + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s + - make WORKSPACE=$WORKSPACE test.summary actions:intel: stage: tests @@ -204,9 +205,9 @@ actions:intel: - make -s -j - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=/lustre/f2/scratch/$USER/runner/$CI_RUNNER_ID test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) - - make test.summary + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s + - make WORKSPACE=$WORKSPACE test.summary # Tests # From b22617c1673770e47e2f03405cd2541476eec356 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 7 Jan 2023 06:35:30 -0500 Subject: [PATCH 143/213] +(*)Use reproducing sums to homogenize fields Added the ability to use reproducing sums to create spatially homogenized tracer fields when Z_INIT_HOMOGENIZE = True, for rotational symmetry and consistency across layouts. The previous version had used non-reproducing sums. This new code is used when HOR_REGRID_ANSWER_DATE >= 20230101, and the comments describing HOR_REGRID_ANSWER_DATE have been updated to reflect this. As a part of this change, the new publicly visible routine homogenize_field was added to the MOM_horizontal_regridding module, so that the homogenization occurs in a single part of the code rather than being spread across several files. By default this commit could lead to answer changes in some cases, depending whether and how HOR_REGRID_ANSWER_DATE is set, but it turns out that the existing single_column test cases that use this have only 4 points and happen to give the same answers with either the older or newer version of the code. This commit addresses MOM6 issue #296 (github.com/NOAA-GFDL/MOM6/issues/296), which can be closed as soon as this commit is merged in to the dev/gfdl branch of MOM6. --- src/framework/MOM_horizontal_regridding.F90 | 112 +++++++++++++----- .../MOM_state_initialization.F90 | 28 +---- .../MOM_tracer_initialization_from_Z.F90 | 1 + .../vertical/MOM_ALE_sponge.F90 | 2 + 4 files changed, 91 insertions(+), 52 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 7a0ace9279..c2fe772571 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -5,6 +5,7 @@ module MOM_horizontal_regridding use MOM_debugging, only : hchksum use MOM_coms, only : max_across_PEs, min_across_PEs, sum_across_PEs, broadcast +use MOM_coms, only : reproducing_sum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_LOOP use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe @@ -24,7 +25,7 @@ module MOM_horizontal_regridding #include -public :: horiz_interp_and_extrap_tracer, myStats +public :: horiz_interp_and_extrap_tracer, myStats, homogenize_field !> Extrapolate and interpolate data interface horiz_interp_and_extrap_tracer @@ -321,7 +322,6 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr logical :: found_attr logical :: add_np logical :: is_ongrid - character(len=8) :: laynum type(horiz_interp_type) :: Interp type(axis_info), dimension(4) :: axes_info ! Axis information used for regridding integer :: is, ie, js, je ! compute domain indices @@ -332,8 +332,6 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr real :: I_scale ! The inverse of the scale factor for diagnostic output [conc CU-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing ! iterations that determines when to stop iterating [CU ~> conc] - real :: npoints ! The number of points in an average [nondim] - real :: varAvg ! The sum of tracer variables being averaged, then their average [CU ~> conc] real, dimension(SZI_(G),SZJ_(G)) :: lon_out ! The longitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: lat_out ! The latitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [CU ~> conc] @@ -461,13 +459,12 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd - write(laynum,'(I8)') k ; laynum = adjustl(laynum) mask_in(:,:) = 0.0 tr_out(:,:) = 0.0 if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k - count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1; start(4) = 1; count(4) = 1 + count(1) = ie-is+1 ; count(2) = je-js+1 ; count(3) = 1 ; start(4) = 1 ; count(4) = 1 call MOM_read_data(trim(filename), trim(varnam), tr_in, start, count, G%Domain) do j=js,je do i=is,ie @@ -487,6 +484,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr start(:) = 1 ; start(3) = k count(:) = 1 ; count(1) = id ; count(2) = jd call read_variable(trim(filename), trim(varnam), tr_in, start=start, nread=count) + if (is_root_pe()) then if (add_np) then pole = 0.0 ; npole = 0.0 @@ -539,14 +537,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr fill(:,:) = 0.0 ; good(:,:) = 0.0 - nPoints = 0 ; varAvg = 0. do j=js,je ; do i=is,ie if (mask_out(i,j) < 1.0) then tr_out(i,j) = missing_value else good(i,j) = 1.0 - nPoints = nPoints + 1 - varAvg = varAvg + tr_out(i,j) endif if ((G%mask2dT(i,j) == 1.0) .and. (z_edges_in(k) <= G%bathyT(i,j) + G%Z_ref) .and. & (mask_out(i,j) < 1.0)) & @@ -561,13 +556,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr ! Horizontally homogenize data to produce perfectly "flat" initial conditions if (PRESENT(homogenize)) then ; if (homogenize) then - !### These averages will not reproduce across PE layouts or grid rotation. - call sum_across_PEs(nPoints) - call sum_across_PEs(varAvg) - if (nPoints>0) then - varAvg = varAvg / real(nPoints) - endif - tr_out(:,:) = varAvg + call homogenize_field(tr_out, mask_out, G, scale, answer_date) endif ; endif ! tr_out contains input z-space data on the model grid with missing values @@ -663,7 +652,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, real :: missing_val_in ! The missing value in the input field [conc] real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] logical :: add_np - character(len=8) :: laynum type(horiz_interp_type) :: Interp type(axistype), dimension(4) :: axes_data integer :: is, ie, js, je ! compute domain indices @@ -677,8 +665,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, real :: I_scale ! The inverse of the scale factor for diagnostic output [conc CU-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing ! iterations that determines when to stop iterating [CU ~> conc] - real :: npoints ! The number of points in an average [nondim] - real :: varAvg ! The sum of tracer variables being averaged, then their average [CU ~> conc] real, dimension(SZI_(G),SZJ_(G)) :: lon_out ! The longitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: lat_out ! The latitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [CU ~> conc] @@ -791,10 +777,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, if (.not.is_ongrid) then if (is_root_pe()) & call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd - write(laynum,'(I8)') k ; laynum = adjustl(laynum) if (is_root_pe()) then tr_in(1:id,1:jd) = data_in(1:id,1:jd,k) if (add_np) then @@ -851,14 +837,11 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, fill(:,:) = 0.0 ; good(:,:) = 0.0 - nPoints = 0 ; varAvg = 0. do j=js,je ; do i=is,ie if (mask_out(i,j) < 1.0) then tr_out(i,j) = missing_value else good(i,j) = 1.0 - nPoints = nPoints + 1 - varAvg = varAvg + tr_out(i,j) endif if ((G%mask2dT(i,j) == 1.0) .and. (z_edges_in(k) <= G%bathyT(i,j) + G%Z_ref) .and. & (mask_out(i,j) < 1.0)) & @@ -873,13 +856,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, ! Horizontally homogenize data to produce perfectly "flat" initial conditions if (PRESENT(homogenize)) then ; if (homogenize) then - !### These averages will not reproduce across PE layouts or grid rotation. - call sum_across_PEs(nPoints) - call sum_across_PEs(varAvg) - if (nPoints>0) then - varAvg = varAvg / real(nPoints) - endif - tr_out(:,:) = varAvg + call homogenize_field(tr_out, mask_out, G, scale, answer_date) endif ; endif ! tr_out contains input z-space data on the model grid with missing values @@ -920,6 +897,81 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, end subroutine horiz_interp_and_extrap_tracer_fms_id +!> Replace all values of a 2-d field with the weighted average over the valid points. +subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: field !< The tracer on the model grid [A ~> a] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: weight !< The weights for the tracer [B ~> b] + real, intent(in) :: scale !< A rescaling factor that has been used for the + !! variable and has to be undone before the + !! reproducing sums [A a-1 ~> 1] + integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. + !! Dates before 20230101 use non-reproducing sums + !! in their averages, while later versions use + !! reproducing sums for rotational symmetry and + !! consistency across PE layouts. + real, optional, intent(in) :: wt_unscale !< A factor that undoes any dimensional scaling + !! of the weights so that they can be used with + !! reproducing sums [b B-1 ~> 1] + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: field_for_Sums ! The field times the weights with the scaling undone [a b] + real, dimension(SZI_(G),SZJ_(G)) :: wts_for_Sums ! A copy of the wieghts with the scaling undone [b] + real :: var_unscale ! The reciprocal of the scaling factor for the field and weights [a b A-1 B-1 ~> 1] + real :: wt_descale ! A factor that undoes any dimensional scaling of the weights so that they + ! can be used with reproducing sums [b B-1 ~> 1] + real :: wt_sum ! The sum of the weights, in [b] (reproducing) or [B ~> b] (non-reproducing) + real :: varsum ! The weighted sum of field being averaged [A B ~> a b] + real :: varAvg ! The average of the field [A ~> a] + logical :: use_repro_sums ! If true, use reproducing sums. + integer :: i, j, is, ie, js, je + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + varAvg = 0.0 ! This value will be used if wt_sum is 0. + + use_repro_sums = .false. ; if (present(answer_date)) use_repro_sums = (answer_date >= 20230101) + + if (scale == 0.0) then + ! This seems like an unlikely case to ever be used, but dealing with it is better than having NaNs arise? + varAvg = 0.0 + elseif (use_repro_sums) then + wt_descale = 1.0 ; if (present(wt_unscale)) wt_descale = wt_unscale + var_unscale = wt_descale / scale + + field_for_Sums(:,:) = 0.0 + wts_for_Sums(:,:) = 0.0 + do j=js,je ; do i=is,ie + wts_for_Sums(i,j) = wt_descale * weight(i,j) + field_for_Sums(i,j) = var_unscale * (field(i,j) * weight(i,j)) + enddo ; enddo + + wt_sum = reproducing_sum(wts_for_Sums) + if (abs(wt_sum) > 0.0) & + varAvg = reproducing_sum(field_for_Sums) * (scale / wt_sum) + + else ! Do the averages with order-dependent sums to reproduce older answers. + wt_sum = 0 ; varsum = 0. + do j=js,je ; do i=is,ie + if (weight(i,j) > 0.0) then + wt_sum = wt_sum + weight(i,j) + varsum = varsum + field(i,j) * weight(i,j) + endif + enddo ; enddo + + ! Note that these averages will not reproduce across PE layouts or grid rotation. + call sum_across_PEs(wt_sum) + if (wt_sum > 0.0) then + call sum_across_PEs(varsum) + varAvg = varsum / wt_sum + endif + endif + + field(:,:) = varAvg + +end subroutine homogenize_field + + !> Create a 2d-mesh of grid coordinates from 1-d arrays. subroutine meshgrid(x, y, x_T, y_T) real, dimension(:), intent(in) :: x !< input 1-dimensional vector diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 49002d4846..1eec90f568 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -92,7 +92,7 @@ module MOM_state_initialization use MOM_regridding, only : regridding_CS, set_regrid_params, getCoordinateResolution use MOM_regridding, only : regridding_main, regridding_preadjust_reqs, convective_adjustment use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h -use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer, homogenize_field use MOM_oda_incupd, only: oda_incupd_CS, initialize_oda_incupd_fixed, initialize_oda_incupd use MOM_oda_incupd, only: set_up_oda_incupd_field, set_up_oda_incupd_vel_field use MOM_oda_incupd, only: calc_oda_increments, output_oda_incupd_inc @@ -2651,6 +2651,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=just_read) @@ -2910,31 +2911,14 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just endif endif - call tracer_z_init_array(temp_z, z_edges_in, kd, zi, temp_land_fill, G, nz, nlevs, eps_z, & - tv%T) - call tracer_z_init_array(salt_z, z_edges_in, kd, zi, salt_land_fill, G, nz, nlevs, eps_z, & - tv%S) + call tracer_z_init_array(temp_z, z_edges_in, kd, zi, temp_land_fill, G, nz, nlevs, eps_z, tv%T) + call tracer_z_init_array(salt_z, z_edges_in, kd, zi, salt_land_fill, G, nz, nlevs, eps_z, tv%S) if (homogenize) then ! Horizontally homogenize data to produce perfectly "flat" initial conditions do k=1,nz - nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. - do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then - nPoints = nPoints + 1 - tempAvg = tempAvg + tv%T(i,j,k) - saltAvg = saltAvg + tv%S(i,j,k) - endif ; enddo ; enddo - - !### These averages will not reproduce across PE layouts or grid rotation. - call sum_across_PEs(nPoints) - call sum_across_PEs(tempAvg) - call sum_across_PEs(saltAvg) - if (nPoints>0) then - tempAvg = tempAvg / real(nPoints) - saltAvg = saltAvg / real(nPoints) - endif - tv%T(:,:,k) = tempAvg - tv%S(:,:,k) = saltAvg + call homogenize_field(tv%T(:,:,k), G%mask2dT, G, scale=US%degC_to_C, answer_date=hor_regrid_answer_date) + call homogenize_field(tv%S(:,:,k), G%mask2dT, G, scale=US%ppt_to_S, answer_date=hor_regrid_answer_date) enddo endif diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 7c62ea496e..bd77ec54d5 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -154,6 +154,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 7ff3bd3701..2e2a3edf07 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -255,6 +255,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) @@ -545,6 +546,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) call get_param(param_file, mdl, "SPONGE_DATA_ONGRID", CS%spongeDataOngrid, & From 334817233d6b45e84a414e70aa098497f1afc54a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 25 Jan 2023 18:05:34 -0500 Subject: [PATCH 144/213] (*)Corrected the units of VarMix_CS%slope_x VarMix_CS%slope_x was being set with units of [Z L-1 ~> nondim], but described in comments as though it was simply [nondim], and then used in the (apparently unused?) calculate_slopes=.false. branch in calc_slope_functions_using_just_e as though its units actually were [nondim]. This commit corrects this inconsistency, while also rescaling the internal slope variables in that routine to also have the proper units of [Z L-1 ~> nondim]. In so doing, several rescaling factors could be eliminated from the calculations. In addition, the slopes used in calc_QG_Leith_viscosity were also being rescaled with the wrong factor or had dimensionally incorrect tiny values in some denominators, and this has been corrected as well. In testing this rescaling fix, a number of other bugs were identified with USE_QG_LEITH_VISC=True (as described at github.com/mom-ocean/MOM6/issues/1590), so a fatal error message was added if this option is enabled. All answers in the MOM6-examples test suite are bitwise identical, but the code will now give a fatal error if USE_QG_LEITH_VISC=.true. --- .../lateral/MOM_hor_visc.F90 | 8 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 90 +++++++++++-------- 2 files changed, 59 insertions(+), 39 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0574297c0c..e6dd131a99 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1936,8 +1936,14 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & "If true, use QG Leith nonlinear eddy viscosity.", & default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + if (CS%use_QG_Leith_visc) then + call MOM_error(FATAL, "USE_QG_LEITH_VISC=True activates code that is a work-in-progress and "//& + "should not be used until a number of bugs are fixed. Specifically it does not "//& + "reproduce across PE count or layout, and may use arrays that have not been properly "//& + "set or allocated. See github.com/mom-ocean/MOM6/issues/1590 for a discussion.") + endif if (CS%use_QG_Leith_visc .and. .not. (CS%Leith_Kh .or. CS%Leith_Ah) ) then - call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& + call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& "LEITH_KH or LEITH_AH must be True when USE_QG_LEITH_VISC=True.") endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 85049025b6..7d71a62e25 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -105,8 +105,8 @@ module MOM_lateral_mixing_coeffs !! spacing squared at v [L2 T-2 ~> m2 s-2]. real, allocatable :: Rd_dx_h(:,:) !< Deformation radius over grid spacing [nondim] - real, allocatable :: slope_x(:,:,:) !< Zonal isopycnal slope [nondim] - real, allocatable :: slope_y(:,:,:) !< Meridional isopycnal slope [nondim] + real, allocatable :: slope_x(:,:,:) !< Zonal isopycnal slope [Z L-1 ~> nondim] + real, allocatable :: slope_y(:,:,:) !< Meridional isopycnal slope [Z L-1 ~> nondim] real, allocatable :: ebt_struct(:,:,:) !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & @@ -142,7 +142,7 @@ module MOM_lateral_mixing_coeffs integer :: Res_fn_power_visc !< The power of dx/Ld in the Kh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. - real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate [nondim]. + real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate [Z L-1 ~> nondim]. ! Leith parameters logical :: use_QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient @@ -514,28 +514,33 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope [nondim] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope [Z L-1 ~> nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency !! at u-points [L2 Z-2 T-2 ~> s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: slope_y !< Meridional isoneutral slope [nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: slope_y !< Meridional isoneutral slope + !! [Z L-1 ~> nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables - real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Positive buoyancy frequency or zero [T-2 ~> s-2] + real :: S2 ! Interface slope squared [Z2 L-2 ~> nondim] + real :: N2 ! Positive buoyancy frequency or zero [L2 Z-2 T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup and Hdn [H ~> m or kg m-2]. - real :: S2max ! An upper bound on the squared slopes [nondim] + real :: S2max ! An upper bound on the squared slopes [Z2 L-2 ~> nondim] real :: wNE, wSE, wSW, wNW ! Weights of adjacent points [nondim] real :: H_u(SZIB_(G)), H_v(SZI_(G)) ! Layer thicknesses at u- and v-points [H ~> m or kg m-2] ! Note that at some points in the code S2_u and S2_v hold the running depth ! integrals of the squared slope [H ~> m or kg m-2] before the average is taken. - real :: S2_u(SZIB_(G),SZJ_(G)) ! The thickness-weighted depth average of the squared slope at u points [nondim]. - real :: S2_v(SZI_(G),SZJB_(G)) ! The thickness-weighted depth average of the squared slope at v points [nondim]. + real :: S2_u(SZIB_(G),SZJ_(G)) ! At first the thickness-weighted depth integral of the squared + ! slope [H Z2 L-2 ~> m or kg m-2] and then the average of the + ! squared slope [Z2 L-2 ~> nondim] at u points. + real :: S2_v(SZI_(G),SZJB_(G)) ! At first the thickness-weighted depth integral of the squared + ! slope [H Z2 L-2 ~> m or kg m-2] and then the average of the + ! squared slope [Z2 L-2 ~> nondim] at v points. integer :: i, j, k, is, ie, js, je, nz, l_seg @@ -545,7 +550,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C if (.not. CS%calculate_Eady_growth_rate) return if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:R"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -563,7 +568,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C ! and midlatitude deformation radii, using calc_resoln_function as a template. !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) - do j = js,je + do j=js,je do I=is-1,ie CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0. enddo @@ -599,7 +604,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C enddo !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) - do J = js-1,je + do J=js-1,je do i=is,ie CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0. enddo @@ -644,7 +649,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C call uvchksum("calc_Visbeck_coeffs_old slope_[xy]", slope_x, slope_y, G%HI, & scale=US%Z_to_L, haloshift=1) call uvchksum("calc_Visbeck_coeffs_old N2_u, N2_v", N2_u, N2_v, G%HI, & - scale=US%L_to_Z**2 * US%s_to_T**2, scalar_pair=.true.) + scale=US%L_to_Z**2*US%s_to_T**2, scalar_pair=.true.) call uvchksum("calc_Visbeck_coeffs_old SN_[uv]", CS%SN_u, CS%SN_v, G%HI, & scale=US%s_to_T, scalar_pair=.true.) endif @@ -698,7 +703,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo ; enddo !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg,vint_SN,sum_dz) - do j = G%jsc-1,G%jec+1 + do j=G%jsc-1,G%jec+1 do I=G%isc-1,G%iec vint_SN(I) = 0. sum_dz(I) = dz_neglect @@ -741,7 +746,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg) - do J = G%jsc-1,G%jec + do J=G%jsc-1,G%jec do i=G%isc-1,G%iec+1 vint_SN(i) = 0. sum_dz(i) = dz_neglect @@ -782,14 +787,14 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo enddo - do j = G%jsc,G%jec + do j=G%jsc,G%jec do I=G%isc-1,G%iec CS%SN_u(I,j) = sqrt( SN_cpy(I,j)**2 & + 0.25*( (CS%SN_v(i,J)**2 + CS%SN_v(i+1,J-1)**2) & + (CS%SN_v(i+1,J)**2 + CS%SN_v(i,J-1)**2) ) ) enddo enddo - do J = G%jsc-1,G%jec + do J=G%jsc-1,G%jec do i=G%isc,G%iec CS%SN_v(i,J) = sqrt( CS%SN_v(i,J)**2 & + 0.25*( (SN_cpy(I,j)**2 + SN_cpy(I-1,j+1)**2) & @@ -816,13 +821,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop logical, intent(in) :: calculate_slopes !< If true, calculate slopes !! internally otherwise use slopes stored in CS ! Local variables - real :: E_x(SZIB_(G),SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) - real :: E_y(SZI_(G),SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) + real :: E_x(SZIB_(G),SZJ_(G)) ! X-slope of interface at u points [Z L-1 ~> nondim] (for diagnostics) + real :: E_y(SZI_(G),SZJB_(G)) ! Y-slope of interface at v points [Z L-1 ~> nondim] (for diagnostics) real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] + real :: S2 ! Interface slope squared [Z2 L-2 ~> nondim] + real :: N2 ! Brunt-Vaisala frequency squared [L2 Z-2 T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. real :: S2N2_u_local(SZIB_(G),SZJ_(G),SZK_(GV)) ! The depth integral of the slope times @@ -857,16 +862,16 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = US%Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = US%Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo - else + else ! This branch is not used. do j=js-1,je+1 ; do I=is-1,ie E_x(I,j) = CS%slope_x(I,j,k) if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. @@ -880,22 +885,22 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop ! Calculate N*S*h from this layer and add to the sum do j=js,je ; do I=is-1,ie S2 = ( E_x(I,j)**2 + 0.25*( & - (E_y(I,j)**2+E_y(I+1,j-1)**2)+(E_y(I+1,j)**2+E_y(I,j-1)**2) ) ) + (E_y(I,j)**2+E_y(I+1,j-1)**2) + (E_y(I+1,j)**2+E_y(I,j-1)**2) ) ) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) + N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 S2N2_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & - (E_x(i,J)**2+E_x(i-1,J+1)**2)+(E_x(i,J+1)**2+E_x(i-1,J)**2) ) ) + (E_x(i,J)**2+E_x(i-1,J+1)**2) + (E_x(i,J+1)**2+E_x(i-1,J)**2) ) ) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) + N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 S2N2_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -960,14 +965,14 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! Local variables real, dimension(SZI_(G),SZJB_(G)) :: & - dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [L-1 ~> m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_v, & ! Magnitude of vorticity gradient at v-points [T-1 L-1 ~> s-1 m-1] grad_div_mag_v ! Magnitude of divergence gradient at v-points [T-1 L-1 ~> s-1 m-1] real, dimension(SZIB_(G),SZJ_(G)) :: & - dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [L-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_u, & ! Magnitude of vorticity gradient at u-points [T-1 L-1 ~> s-1 m-1] @@ -987,41 +992,50 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if ((k > 1) .and. (k < nz)) then + ! With USE_QG_LEITH_VISC=True, this might need to change to + ! do j=js-2,je+2 ; do I=is-2,ie+1 + ! but other arrays used here (e.g., h and CS%slope_x) would also need to have wider valid halos. do j=js-1,je+1 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & - + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff ) + + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff**2 ) h_at_slope_below = 2. * ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) * h(i+1,j,k+1) ) / & ( ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) & - + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff ) + + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff**2 ) Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + ! With USE_QG_LEITH_VISC=True, this might need to change to + ! do J=js-2,je+1 ; do i=is-2,ie+2 do J=js-2,Jeq+1 ; do i=is-1,ie+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) * h(i,j+1,k) ) / & ( ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) + h(i,j+1,k) ) & - + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff ) + + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff**2 ) h_at_slope_below = 2. * ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) * h(i,j+1,k+1) ) / & ( ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) & - + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff ) + + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff**2 ) Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + ! With USE_QG_LEITH_VISC=True, this might need to be + ! do J=js-2,je+1 ; do i=is-1,ie+1 do J=js-1,je ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) - vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo + ! With USE_QG_LEITH_VISC=True, this might need to be + ! do j=js-1,je+1 ; do I=is-2,ie+1 do j=js-1,Jeq+1 ; do I=is-1,ie f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) - vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * US%L_to_Z * & + vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -1236,7 +1250,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If non-zero, is an upper bound on slopes used in the "//& "Visbeck formula for diffusivity. This does not affect the "//& "isopycnal slope calculation used within thickness diffusion.", & - units="nondim", default=0.0) + units="nondim", default=0.0, scale=US%L_to_Z) else CS%Visbeck_S_max = 0. endif From 0b857c0e8202e9a775676c135094ca9aa6c567a8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 28 Jan 2023 08:43:39 -0500 Subject: [PATCH 145/213] Cancel out rescaling factors in wave_speed Incorporated a slope squared rescaling factor into the definition of the local N2min variable in wave_speed, thereby eliminating 4 points in the code where rescaling had been necessary and another local variable. All answers and output are bitwise identical. --- src/diagnostics/MOM_wave_speed.F90 | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 34669ae706..9c8cd099f3 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -128,7 +128,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 L-2 ~> 1]. real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and ! its derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. @@ -156,7 +155,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: hw ! The mean of the adjacent layer thicknesses [Z ~> m] real :: sum_hc ! The sum of the layer thicknesses [Z ~> m] real :: gp ! A limited local copy of gprime [L2 Z-1 T-2 ~> m s-2] - real :: N2min ! A minimum buoyancy frequency [T-2 ~> s-2] + real :: N2min ! A minimum buoyancy frequency, including a slope rescaling factor [L2 Z-2 T-2 ~> s-2] logical :: l_use_ebt_mode, calc_modal_structure real :: l_mono_N2_column_fraction ! A local value of mono_N2_column_fraction [nondim] real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [Z ~> m] @@ -174,8 +173,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif - L2_to_Z2 = US%L_to_Z**2 - l_use_ebt_mode = CS%use_ebt_mode if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode l_mono_N2_column_fraction = CS%mono_N2_column_fraction @@ -219,7 +216,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2, & +!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale, & !$OMP better_est,cg1_min2,tol_merge,tol_solve,c2_scale) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT,drho_dS, & @@ -453,7 +450,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ if (l_use_ebt_mode) then Igu(1) = 0. ! Neumann condition for pressure modes sum_hc = Hc(1) - N2min = L2_to_Z2*gprime(2)/Hc(1) + N2min = gprime(2)/Hc(1) do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) @@ -461,12 +458,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !### Change to: if ( ((htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) .or. & ) ) if ( (((G%bathyT(i,j)+G%Z_ref) - sum_hc < l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) .or. & ((l_mono_N2_depth >= 0.) .and. (sum_hc > l_mono_N2_depth))) .and. & - (L2_to_Z2*gp > N2min*hw) ) then + (gp > N2min*hw) ) then ! Filters out regions where N2 increases with depth but only in a lower fraction ! of the water column or below a certain depth. - gp = US%Z_to_L**2 * (N2min*hw) + gp = N2min * hw else - N2min = L2_to_Z2 * gp/hw + N2min = gp / hw endif endif Igu(k) = 1.0/(gp*Hc(k)) From 1a51c504c58a71ca15d02319b6c00e24eb759946 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 7 Jan 2023 12:33:58 -0500 Subject: [PATCH 146/213] Use rescaled variables for global mean T & S diags Use rescaled variables for 6 global mean temperature and salinity diagnostics, using the tmp_scale arguments to the various global mean functions so that they have conversion factors that can be verified against their declared units in their register_scalar_field calls. Also added or corrected unit descriptions for a handful of variables in the MOM_diagnostics module. All answers and output are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 144 ++++++++++++++-------------- 1 file changed, 71 insertions(+), 73 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 11a37c8589..ff65a3b60b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -54,7 +54,7 @@ module MOM_diagnostics logical :: initialized = .false. !< True if this control structure has been initialized. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as !! monotonic for the purposes of calculating the equivalent - !! barotropic wave speed. + !! barotropic wave speed [nondim]. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed [Z ~> m]. @@ -203,7 +203,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! including [nondim] and [H ~> m or kg m-2]. real :: uh_tmp(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary zonal transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vh_tmp(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary meridional transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. + real :: mass_cell(SZI_(G),SZJ_(G)) ! The vertically integrated mass in a grid cell [kg] real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] real :: cg1(SZI_(G),SZJ_(G)) ! First baroclinic gravity wave speed [L T-1 ~> m s-1] real :: Rd1(SZI_(G),SZJ_(G)) ! First baroclinic deformation radius [L ~> m] @@ -221,13 +221,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & integer :: k_list - real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [degC] - real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [degC] - real :: thetaoga ! The volume mean potential temperature [degC] - real :: soga ! The volume mean ocean salinity [ppt] + real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [C ~> degC] + real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [S ~> ppt] + real :: thetaoga ! The volume mean potential temperature [C ~> degC] + real :: soga ! The volume mean ocean salinity [S ~> ppt] real :: masso ! The total mass of the ocean [kg] - real :: tosga ! The area mean sea surface temperature [degC] - real :: sosga ! The area mean sea surface salinity [ppt] + real :: tosga ! The area mean sea surface temperature [C ~> degC] + real :: sosga ! The area mean sea surface salinity [S ~> ppt] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -334,11 +334,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! mass of liquid ocean (for Bouss, use Rho0). The reproducing sum requires the use of MKS units. if (CS%id_masso > 0) then - work_2d(:,:) = 0.0 + mass_cell(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - 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) + mass_cell(i,j) = mass_cell(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo - masso = reproducing_sum(work_2d) + masso = reproducing_sum(mass_cell) call post_data(CS%id_masso, masso, CS%diag) endif @@ -458,37 +458,37 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! volume mean potential temperature if (CS%id_thetaoga>0) then - thetaoga = global_volume_mean(tv%T, h, G, GV, scale=US%C_to_degC) + thetaoga = global_volume_mean(tv%T, h, G, GV, tmp_scale=US%C_to_degC) call post_data(CS%id_thetaoga, thetaoga, CS%diag) endif ! area mean SST if (CS%id_tosga > 0) then - tosga = global_area_mean(tv%T(:,:,1), G, scale=US%C_to_degC) + tosga = global_area_mean(tv%T(:,:,1), G, tmp_scale=US%C_to_degC) call post_data(CS%id_tosga, tosga, CS%diag) endif ! volume mean salinity if (CS%id_soga>0) then - soga = global_volume_mean(tv%S, h, G, GV, scale=US%S_to_ppt) + soga = global_volume_mean(tv%S, h, G, GV, tmp_scale=US%S_to_ppt) call post_data(CS%id_soga, soga, CS%diag) endif ! area mean SSS if (CS%id_sosga > 0) then - sosga = global_area_mean(tv%S(:,:,1), G, scale=US%S_to_ppt) + sosga = global_area_mean(tv%S(:,:,1), G, tmp_scale=US%S_to_ppt) call post_data(CS%id_sosga, sosga, CS%diag) endif ! layer mean potential temperature if (CS%id_temp_layer_ave>0) then - temp_layer_ave = global_layer_mean(tv%T, h, G, GV, scale=US%C_to_degC) + temp_layer_ave = global_layer_mean(tv%T, h, G, GV, tmp_scale=US%C_to_degC) call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) endif ! layer mean salinity if (CS%id_salt_layer_ave>0) then - salt_layer_ave = global_layer_mean(tv%S, h, G, GV, scale=US%S_to_ppt) + salt_layer_ave = global_layer_mean(tv%S, h, G, GV, tmp_scale=US%S_to_ppt) call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif @@ -834,7 +834,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a !! previous call to diagnostics_init. - real, dimension(SZI_(G), SZJ_(G)) :: & + real, dimension(SZI_(G),SZJ_(G)) :: & z_top, & ! Height of the top of a layer or the ocean [Z ~> m]. z_bot, & ! Height of the bottom of a layer (for id_mass) or the ! (positive) depth of the ocean (for id_col_ht) [Z ~> m]. @@ -891,7 +891,6 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then IG_Earth = 1.0 / GV%g_Earth -! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=G%jscB,G%jecB+1 ; do i=G%iscB,G%iecB+1 z_bot(i,j) = 0.0 enddo ; enddo @@ -1207,9 +1206,10 @@ end subroutine calculate_energy_diagnostics subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) integer, intent(in), dimension(3) :: lb !< Lower index bound of f_ptr real, dimension(lb(1):,lb(2):,:), target :: f_ptr - !< Time derivative operand + !< Time derivative operand, in arbitrary units [A ~> a] real, dimension(lb(1):,lb(2):,:), target :: deriv_ptr - !< Time derivative of f_ptr + !< Time derivative of f_ptr, in units derived from + !! the arbitrary units of f_ptr [A T-1 ~> a s-1] type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. @@ -1329,7 +1329,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] - real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array [various] real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [Z ~> m] real :: I_time_int ! The inverse of the time interval [T-1 ~> s-1]. @@ -1475,10 +1475,10 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry ! Local variables - real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZIB_(G),SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZI_(G),SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tend ! Change in layer thickness due to dynamics ! [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [T-1 ~> s-1] @@ -1637,11 +1637,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag flux_units = get_flux_units(GV) convert_H = GV%H_to_MKS - CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL,& + CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL, & Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & !### , conversion=GV%H_to_kg_m2, & standard_name='sea_water_mass_per_unit_area', v_extensive=.true.) - CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & + CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & diag, 'Mass of liquid ocean', 'kg', standard_name='sea_water_mass') CS%id_thkcello = register_diag_field('ocean_model', 'thkcello', diag%axesTL, Time, & @@ -1683,38 +1683,38 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag standard_name='Salinity Squared') CS%id_temp_layer_ave = register_diag_field('ocean_model', 'temp_layer_ave', & - diag%axesZL, Time, 'Layer Average Ocean Temperature', 'degC') + diag%axesZL, Time, 'Layer Average Ocean Temperature', units='degC', conversion=US%C_to_degC) CS%id_salt_layer_ave = register_diag_field('ocean_model', 'salt_layer_ave', & - diag%axesZL, Time, 'Layer Average Ocean Salinity', 'psu') + diag%axesZL, Time, 'Layer Average Ocean Salinity', units='psu', conversion=US%S_to_ppt) CS%id_thetaoga = register_scalar_field('ocean_model', 'thetaoga', & - Time, diag, 'Global Mean Ocean Potential Temperature', 'degC', & + Time, diag, 'Global Mean Ocean Potential Temperature', units='degC', conversion=US%C_to_degC, & standard_name='sea_water_potential_temperature') CS%id_soga = register_scalar_field('ocean_model', 'soga', & - Time, diag, 'Global Mean Ocean Salinity', 'psu', & + Time, diag, 'Global Mean Ocean Salinity', units='psu', conversion=US%S_to_ppt, & standard_name='sea_water_salinity') - CS%id_tosga = register_scalar_field('ocean_model', 'sst_global', Time, diag,& - long_name='Global Area Average Sea Surface Temperature', & - units='degC', standard_name='sea_surface_temperature', & - cmor_field_name='tosga', cmor_standard_name='sea_surface_temperature', & + CS%id_tosga = register_scalar_field('ocean_model', 'sst_global', Time, diag, & + long_name='Global Area Average Sea Surface Temperature', & + units='degC', conversion=US%C_to_degC, standard_name='sea_surface_temperature', & + cmor_field_name='tosga', cmor_standard_name='sea_surface_temperature', & cmor_long_name='Sea Surface Temperature') - CS%id_sosga = register_scalar_field('ocean_model', 'sss_global', Time, diag,& - long_name='Global Area Average Sea Surface Salinity', & - units='psu', standard_name='sea_surface_salinity', & - cmor_field_name='sosga', cmor_standard_name='sea_surface_salinity', & + CS%id_sosga = register_scalar_field('ocean_model', 'sss_global', Time, diag, & + long_name='Global Area Average Sea Surface Salinity', & + units='psu', conversion=US%S_to_ppt, standard_name='sea_surface_salinity', & + cmor_field_name='sosga', cmor_standard_name='sea_surface_salinity', & cmor_long_name='Sea Surface Salinity') endif - CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & + CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & 'Zonal velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='uo', & cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') - CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & + CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & 'Meridional velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='vo', & cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') - CS%id_usq = register_diag_field('ocean_model', 'usq', diag%axesCuL, Time, & + CS%id_usq = register_diag_field('ocean_model', 'usq', diag%axesCuL, Time, & 'Zonal velocity squared', 'm2 s-2', conversion=US%L_T_to_m_s**2) - CS%id_vsq = register_diag_field('ocean_model', 'vsq', diag%axesCvL, Time, & + CS%id_vsq = register_diag_field('ocean_model', 'vsq', diag%axesCvL, Time, & 'Meridional velocity squared', 'm2 s-2', conversion=US%L_T_to_m_s**2) CS%id_uv = register_diag_field('ocean_model', 'uv', diag%axesTL, Time, & 'Product between zonal and meridional velocities at h-points', & @@ -1864,22 +1864,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag wave_speed_tol=wave_speed_tol) endif - CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & + CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & 'The column mass for calculating mass-weighted average properties', 'kg m-2', conversion=US%RZ_to_kg_m2) if (use_temperature) then - CS%id_temp_int = register_diag_field('ocean_model', 'temp_int', diag%axesT1, Time, & + CS%id_temp_int = register_diag_field('ocean_model', 'temp_int', diag%axesT1, Time, & 'Density weighted column integrated potential temperature', & 'degC kg m-2', conversion=US%C_to_degC*US%RZ_to_kg_m2, & - cmor_field_name='opottempmint', & - cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature',& + cmor_field_name='opottempmint', & + cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature', & cmor_standard_name='Depth integrated density times potential temperature') - CS%id_salt_int = register_diag_field('ocean_model', 'salt_int', diag%axesT1, Time, & + CS%id_salt_int = register_diag_field('ocean_model', 'salt_int', diag%axesT1, Time, & 'Density weighted column integrated salinity', & 'psu kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, & - cmor_field_name='somint', & - cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_salinity',& + cmor_field_name='somint', & + cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_salinity', & cmor_standard_name='Depth integrated density times salinity') endif @@ -1909,18 +1909,18 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! Vertically integrated, budget, and surface state diagnostics - IDs%id_volo = register_scalar_field('ocean_model', 'volo', Time, diag,& - long_name='Total volume of liquid ocean', units='m3', & + IDs%id_volo = register_scalar_field('ocean_model', 'volo', Time, diag, & + long_name='Total volume of liquid ocean', units='m3', & standard_name='sea_water_volume') - IDs%id_zos = register_diag_field('ocean_model', 'zos', diag%axesT1, Time,& - standard_name = 'sea_surface_height_above_geoid', & + IDs%id_zos = register_diag_field('ocean_model', 'zos', diag%axesT1, Time, & + standard_name = 'sea_surface_height_above_geoid', & long_name= 'Sea surface height above geoid', units='m', conversion=US%Z_to_m) - IDs%id_zossq = register_diag_field('ocean_model', 'zossq', diag%axesT1, Time,& - standard_name='square_of_sea_surface_height_above_geoid', & + IDs%id_zossq = register_diag_field('ocean_model', 'zossq', diag%axesT1, Time, & + standard_name='square_of_sea_surface_height_above_geoid', & long_name='Square of sea surface height above geoid', units='m2', conversion=US%Z_to_m**2) IDs%id_ssh = register_diag_field('ocean_model', 'SSH', diag%axesT1, Time, & 'Sea Surface Height', 'm', conversion=US%Z_to_m) - IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag,& + IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag, & long_name='Area averaged sea surface height', units='m', conversion=US%Z_to_m, & standard_name='area_averaged_sea_surface_height') IDs%id_ssu = register_diag_field('ocean_model', 'SSU', diag%axesCu1, Time, & @@ -1931,7 +1931,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 'Sea Surface Speed', 'm s-1', conversion=US%L_T_to_m_s) if (associated(tv%T)) then - IDs%id_sst = register_diag_field('ocean_model', 'SST', diag%axesT1, Time, & + IDs%id_sst = register_diag_field('ocean_model', 'SST', diag%axesT1, Time, & 'Sea Surface Temperature', 'degC', conversion=US%C_to_degC, & cmor_field_name='tos', cmor_long_name='Sea Surface Temperature', & cmor_standard_name='sea_surface_temperature') @@ -1948,11 +1948,11 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) cmor_field_name='sossq', cmor_long_name='Square of Sea Surface Salinity ', & cmor_standard_name='square_of_sea_surface_salinity') if (tv%T_is_conT) then - IDs%id_sstcon = register_diag_field('ocean_model', 'conSST', diag%axesT1, Time, & + IDs%id_sstcon = register_diag_field('ocean_model', 'conSST', diag%axesT1, Time, & 'Sea Surface Conservative Temperature', 'Celsius', conversion=US%C_to_degC) endif if (tv%S_is_absS) then - IDs%id_sssabs = register_diag_field('ocean_model', 'absSSS', diag%axesT1, Time, & + IDs%id_sssabs = register_diag_field('ocean_model', 'absSSS', diag%axesT1, Time, & 'Sea Surface Absolute Salinity', 'g kg-1', conversion=US%S_to_ppt) endif if (associated(tv%frazil)) then @@ -1970,7 +1970,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) IDs%id_Heat_PmE = register_diag_field('ocean_model', 'Heat_PmE', diag%axesT1, Time, & 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) - IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& + IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time, & 'Heat flux into ocean from geothermal or other internal sources', & 'W m-2', conversion=US%QRZ_T_to_W_m2) @@ -1981,15 +1981,13 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real :: H_convert character(len=48) :: thickness_units, accum_flux_units thickness_units = get_thickness_units(GV) - H_convert = GV%H_to_MKS if (GV%Boussinesq) then accum_flux_units = "m3" else @@ -1999,10 +1997,10 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) ! Diagnostics related to tracer and mass transport IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', & - accum_flux_units, y_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) + accum_flux_units, y_cell_method='sum', v_extensive=.true., conversion=GV%H_to_MKS*US%L_to_m**2) IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', & - accum_flux_units, x_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) + accum_flux_units, x_cell_method='sum', v_extensive=.true., conversion=GV%H_to_MKS*US%L_to_m**2) IDs%id_umo = register_diag_field('ocean_model', 'umo', & diag%axesCuL, Time, 'Ocean Mass X Transport', & 'kg s-1', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2, & @@ -2019,10 +2017,10 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) diag%axesCv1, Time, 'Ocean Mass Y Transport Vertical Sum', & 'kg s-1', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2, & standard_name='ocean_mass_y_transport_vertical_sum', x_cell_method='sum') - IDs%id_dynamics_h = register_diag_field('ocean_model','dynamics_h', & + IDs%id_dynamics_h = register_diag_field('ocean_model','dynamics_h', & diag%axesTl, Time, 'Layer thicknesses prior to horizontal dynamics', & thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.) - IDs%id_dynamics_h_tendency = register_diag_field('ocean_model','dynamics_h_tendency', & + IDs%id_dynamics_h_tendency = register_diag_field('ocean_model','dynamics_h_tendency', & diag%axesTl, Time, 'Change in layer thicknesses due to horizontal dynamics', & trim(thickness_units)//" s-1", conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) @@ -2037,7 +2035,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output ! Local variables - real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. + real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array [Z ~> m] integer :: id, i, j logical :: use_temperature @@ -2104,10 +2102,10 @@ subroutine write_static_fields(G, GV, US, tv, diag) x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaBu, diag, .true.) - id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & + id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & 'Depth of the ocean at tracer points', 'm', conversion=US%Z_to_m, & - standard_name='sea_floor_depth_below_geoid', & - cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & + standard_name='sea_floor_depth_below_geoid', & + cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & cmor_standard_name='sea_floor_depth_below_geoid', area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) then From f3b1a61d5bb9f5292cc0cd1f03935122c6af619b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 05:08:11 -0500 Subject: [PATCH 147/213] +Add optional unscale argument to check_redundant Added an optional unscale argument to the various check_redundant and chksum_vec routines so that the values that are written out in error messages are independent of rescaling values. Also added or amended comments to document the units of numerous internal variables and function arguments in MOM_debugging.F90. All answers are bitwise identical, but there are new optional arguments to several publicly visible routines. --- src/diagnostics/MOM_debugging.F90 | 362 +++++++++++++++++++----------- 1 file changed, 236 insertions(+), 126 deletions(-) diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index fd7e891e82..15e555ee37 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -76,11 +76,11 @@ module MOM_debugging contains !> MOM_debugging_init initializes the MOM_debugging module, and sets -!! the parameterts that control which checks are active for MOM6. +!! the parameters that control which checks are active for MOM6. subroutine MOM_debugging_init(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_debugging" ! This module's name. call log_version(param_file, mdl, version, debugging=.true.) @@ -102,19 +102,24 @@ end subroutine MOM_debugging_init !> Check for consistency between the duplicated points of a 3-D C-grid vector subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] + ! Local variables character(len=24) :: mesg_k integer :: k @@ -126,30 +131,37 @@ subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_vC2d(trim(mesg)//trim(mesg_k), u_comp(:,:,k), & - v_comp(:,:,k), G, is, ie, js, je, direction) + v_comp(:,:,k), G, is, ie, js, je, direction, unscale) enddo end subroutine check_redundant_vC3d !> Check for consistency between the duplicated points of a 2-D C-grid vector subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed) - real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input vector while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of u_comp [A ~> a] + real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of v_comp [A ~> a] + real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed) ! A reconstructed symmetric version of u_comp [A ~> a] + real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB) ! A reconstructed symmetric version of v_comp [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -163,6 +175,8 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if ((isd == IsdB) .and. (jsd == JsdB)) return endif + sc = 1.0 ; if (present(unscale)) sc = unscale + do i=isd,ied ; do j=jsd,jed u_nonsym(i,j) = u_comp(i,j) ; v_nonsym(i,j) = v_comp(i,j) enddo ; enddo @@ -187,7 +201,7 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(3) < max_redundant_prints) then write(mesg2,'(" redundant u-components",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - u_comp(i,j), u_resym(i,j),u_comp(i,j)-u_resym(i,j),i,j,pe_here() + sc*u_comp(i,j), sc*u_resym(i,j), sc*(u_comp(i,j)-u_resym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(3) = redundant_prints(3) + 1 endif @@ -197,7 +211,7 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(3) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & - v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, & + sc*v_comp(i,j), sc*v_resym(i,j), sc*(v_comp(i,j)-v_resym(i,j)), i, j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) redundant_prints(3) = redundant_prints(3) + 1 @@ -207,14 +221,17 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vC2d !> Check for consistency between the duplicated points of a 3-D scalar at corner points -subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k @@ -227,22 +244,28 @@ subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je) else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_sB2d(trim(mesg)//trim(mesg_k), array(:,:,k), & - G, is, ie, js, je) + G, is, ie, js, je, unscale) enddo end subroutine check_redundant_sB3d !> Check for consistency between the duplicated points of a 2-D scalar at corner points -subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: a_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of array [A ~> a] + real :: a_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) ! A reconstructed symmetric version of array [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -256,6 +279,8 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) if ((isd == IsdB) .and. (jsd == JsdB)) return endif + sc = 1.0 ; if (present(unscale)) sc = unscale + do i=isd,ied ; do j=jsd,jed a_nonsym(i,j) = array(i,j) enddo ; enddo @@ -281,7 +306,7 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" Redundant points",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - array(i,j), a_resym(i,j),array(i,j)-a_resym(i,j),i,j,pe_here() + sc*array(i,j), sc*a_resym(i,j), sc*(array(i,j)-a_resym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(2) = redundant_prints(2) + 1 endif @@ -291,19 +316,23 @@ end subroutine check_redundant_sB2d !> Check for consistency between the duplicated points of a 3-D B-grid vector subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k integer :: k @@ -315,30 +344,37 @@ subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_vB2d(trim(mesg)//trim(mesg_k), u_comp(:,:,k), & - v_comp(:,:,k), G, is, ie, js, je, direction) + v_comp(:,:,k), G, is, ie, js, je, direction, unscale) enddo end subroutine check_redundant_vB3d !> Check for consistency between the duplicated points of a 2-D B-grid vector subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: u_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) - real :: v_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input vector while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of u_comp [A ~> a] + real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of v_comp [A ~> a] + real :: u_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) ! A reconstructed symmetric version of u_comp [A ~> a] + real :: v_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) ! A reconstructed symmetric version of v_comp [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -352,6 +388,8 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if ((isd == IsdB) .and. (jsd == JsdB)) return endif + sc = 1.0 ; if (present(unscale)) sc = unscale + do i=isd,ied ; do j=jsd,jed u_nonsym(i,j) = u_comp(i,j) ; v_nonsym(i,j) = v_comp(i,j) enddo ; enddo @@ -377,7 +415,7 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" redundant u-components",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - u_comp(i,j), u_resym(i,j),u_comp(i,j)-u_resym(i,j),i,j,pe_here() + sc*u_comp(i,j), sc*u_resym(i,j), sc*(u_comp(i,j)-u_resym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(2) = redundant_prints(2) + 1 endif @@ -387,7 +425,7 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & - v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, & + sc*v_comp(i,j), sc*v_resym(i,j), sc*(v_comp(i,j)-v_resym(i,j)), i, j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) redundant_prints(2) = redundant_prints(2) + 1 @@ -397,14 +435,17 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vB2d !> Check for consistency between the duplicated points of a 3-D scalar at tracer points -subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%isd:,G%jsd:,:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k integer :: k @@ -416,22 +457,28 @@ subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_sT2d(trim(mesg)//trim(mesg_k), array(:,:,k), & - G, is, ie, js, je) + G, is, ie, js, je, unscale) enddo end subroutine check_redundant_sT3d !> Check for consistency between the duplicated points of a 2-D scalar at tracer points -subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%isd:,G%jsd:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A version of array with halo points updated by message passing [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch @@ -442,6 +489,8 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) if (present(is)) is_ch = is ; if (present(ie)) ie_ch = ie if (present(js)) js_ch = js ; if (present(js)) je_ch = je + sc = 1.0 ; if (present(unscale)) sc = unscale + ! This only works on points outside of the standard computational domain. if ((is_ch == G%isc) .and. (ie_ch == G%iec) .and. & (js_ch == G%jsc) .and. (je_ch == G%jec)) return @@ -457,7 +506,7 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" Redundant points",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - array(i,j), a_nonsym(i,j),array(i,j)-a_nonsym(i,j),i,j,pe_here() + sc*array(i,j), sc*a_nonsym(i,j), sc*(array(i,j)-a_nonsym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(1) = redundant_prints(1) + 1 endif @@ -467,19 +516,23 @@ end subroutine check_redundant_sT2d !> Check for consistency between the duplicated points of a 3-D A-grid vector subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k integer :: k @@ -491,28 +544,35 @@ subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, & else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_vT2d(trim(mesg)//trim(mesg_k), u_comp(:,:,k), & - v_comp(:,:,k), G, is, ie, js, je, direction) + v_comp(:,:,k), G, is, ie, js, je, direction, unscale) enddo end subroutine check_redundant_vT3d !> Check for consistency between the duplicated points of a 2-D A-grid vector subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input vector while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A version of u_comp with halo points updated by message passing [A ~> a] + real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A version of v_comp with halo points updated by message passing [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch @@ -525,6 +585,8 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if (present(is)) is_ch = is ; if (present(ie)) ie_ch = ie if (present(js)) js_ch = js ; if (present(js)) je_ch = je + sc = 1.0 ; if (present(unscale)) sc = unscale + ! This only works on points outside of the standard computational domain. if ((is_ch == G%isc) .and. (ie_ch == G%iec) .and. & (js_ch == G%jsc) .and. (je_ch == G%jec)) return @@ -540,7 +602,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" redundant u-components",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - u_comp(i,j), u_nonsym(i,j),u_comp(i,j)-u_nonsym(i,j),i,j,pe_here() + sc*u_comp(i,j), sc*u_nonsym(i,j), sc*(u_comp(i,j)-u_nonsym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(1) = redundant_prints(1) + 1 endif @@ -550,7 +612,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & - v_comp(i,j), v_nonsym(i,j),v_comp(i,j)-v_nonsym(i,j),i,j, & + sc*v_comp(i,j), sc*v_nonsym(i,j), sc*(v_comp(i,j)-v_nonsym(i,j)), i, j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) redundant_prints(1) = redundant_prints(1) + 1 @@ -559,163 +621,202 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vT2d + +! It appears that none of the other routines in this file are ever called. + !> Do a checksum and redundant point check on a 3d C-grid vector. -subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_C(mesg, u_comp, v_comp, G) + call check_redundant_C(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_C3d !> Do a checksum and redundant point check on a 2d C-grid vector. -subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_C(mesg, u_comp, v_comp, G) + call check_redundant_C(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_C2d !> Do a checksum and redundant point check on a 3d B-grid vector. -subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call Bchksum(u_comp, mesg//"(u)", G%HI, halos) - call Bchksum(v_comp, mesg//"(v)", G%HI, halos) + call Bchksum(u_comp, mesg//"(u)", G%HI, halos, scale=unscale) + call Bchksum(v_comp, mesg//"(v)", G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_B(mesg, u_comp, v_comp, G) + call check_redundant_B(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_B3d ! Do a checksum and redundant point check on a 2d B-grid vector. -subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) +subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. logical, optional, intent(in) :: symmetric !< If true, do the checksums on the !! full symmetric computational domain. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call Bchksum(u_comp, mesg//"(u)", G%HI, halos, symmetric=symmetric) - call Bchksum(v_comp, mesg//"(v)", G%HI, halos, symmetric=symmetric) + call Bchksum(u_comp, mesg//"(u)", G%HI, halos, symmetric=symmetric, scale=unscale) + call Bchksum(v_comp, mesg//"(v)", G%HI, halos, symmetric=symmetric, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_B(mesg, u_comp, v_comp, G) + call check_redundant_B(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_B2d !> Do a checksum and redundant point check on a 3d C-grid vector. -subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call hchksum(u_comp, mesg//"(u)", G%HI, halos) - call hchksum(v_comp, mesg//"(v)", G%HI, halos) + call hchksum(u_comp, mesg//"(u)", G%HI, halos, scale=unscale) + call hchksum(v_comp, mesg//"(v)", G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_T(mesg, u_comp, v_comp, G) + call check_redundant_T(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_A3d !> Do a checksum and redundant point check on a 2d C-grid vector. -subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call hchksum(u_comp, mesg//"(u)", G%HI, halos) - call hchksum(v_comp, mesg//"(v)", G%HI, halos) + call hchksum(u_comp, mesg//"(u)", G%HI, halos, scale=unscale) + call hchksum(v_comp, mesg//"(v)", G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_T(mesg, u_comp, v_comp, G) + call check_redundant_T(mesg, u_comp, v_comp, G, unscale=unscale) endif endif @@ -725,12 +826,12 @@ end subroutine chksum_vec_A2d !! processors of hThick*stuff, where stuff is a 3-d array at tracer points. function totalStuff(HI, hThick, areaT, stuff) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights [m] real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas [m2] - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed - real :: totalStuff !< the globally integrated amoutn of stuff + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed in arbitrary units [a] + real :: totalStuff !< the globally integrated amount of stuff [a m3] ! Local variables - real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum + real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum ! The column integrated amount of stuff in a cell [a m3] integer :: i, j, k, nz nz = size(hThick,3) @@ -746,18 +847,22 @@ end function totalStuff !! as well as the change since the last call. subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights [m] real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas [m2] - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum [degC] + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum [ppt] character(len=*), intent(in) :: mesg !< An identifying message ! NOTE: This subroutine uses "save" data which is not thread safe and is purely for ! extreme debugging without a proper debugger. - real, save :: totalH = 0., totalT = 0., totalS = 0. + real, save :: totalH = 0. ! The total ocean volume, saved for the next call [m3] + real, save :: totalT = 0. ! The total volume integrated ocean temperature, saved for the next call [degC m3] + real, save :: totalS = 0. ! The total volume integrated ocean salinity, saved for the next call [ppt m3] ! Local variables logical, save :: firstCall = .true. - real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum - real :: thisH, thisT, thisS, delH, delT, delS + real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum ! The volume of each column [m3] + real :: thisH, delH ! The total ocean volume and the change from the last call [m3] + real :: thisT, delT ! The current total volume integrated temperature and the change from the last call [degC m3] + real :: thisS, delS ! The current total volume integrated salinity and the change from the last call [ppt m3] integer :: i, j, k, nz nz = size(hThick,3) @@ -788,11 +893,13 @@ end subroutine totalTandS !> Returns false if the column integral of a given quantity is within roundoff logical function check_column_integral(nk, field, known_answer) integer, intent(in) :: nk !< Number of levels in column - real, dimension(nk), intent(in) :: field !< Field to be summed - real, optional, intent(in) :: known_answer !< If present is the expected sum, + real, dimension(nk), intent(in) :: field !< Field to be summed [arbitrary] + real, optional, intent(in) :: known_answer !< If present is the expected sum [arbitrary], !! If missing, assumed zero ! Local variables - real :: u_sum, error, expected + real :: u_sum ! The vertical sum of the field [arbitrary] + real :: error ! An estimate of the roundoff error in the sum [arbitrary] + real :: expected ! The expected vertical sum [arbitrary] integer :: k u_sum = field(1) @@ -824,12 +931,15 @@ end function check_column_integral logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_value) integer, intent(in) :: nk_1 !< Number of levels in field 1 integer, intent(in) :: nk_2 !< Number of levels in field 2 - real, dimension(nk_1), intent(in) :: field_1 !< First field to be summed - real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed + real, dimension(nk_1), intent(in) :: field_1 !< First field to be summed [arbitrary] + real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed [arbitrary] real, optional, intent(in) :: missing_value !< If column contains missing values, - !! mask them from the sum + !! mask them from the sum [arbitrary] ! Local variables - real :: u1_sum, error1, u2_sum, error2, misval + real :: u1_sum, u2_sum ! The vertical sums of the two fields [arbitrary] + real :: error1, error2 ! Estimates of the roundoff errors in the sums [arbitrary] + real :: misval ! The missing value flag, indicating elements that are to be omitted + ! from the sums [arbitrary] integer :: k ! Assign missing value @@ -844,7 +954,7 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_va ! Reintegrate and sum roundoff errors do k=2,nk_1 - if (field_1(k)/=misval) then + if (field_1(k) /= misval) then u1_sum = u1_sum + field_1(k) error1 = error1 + EPSILON(u1_sum)*MAX(ABS(u1_sum),ABS(field_1(k))) endif @@ -855,7 +965,7 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_va ! Reintegrate and sum roundoff errors do k=2,nk_2 - if (field_2(k)/=misval) then + if (field_2(k) /= misval) then u2_sum = u2_sum + field_2(k) error2 = error2 + EPSILON(u2_sum)*MAX(ABS(u2_sum),ABS(field_2(k))) endif From 09880a8efae8e1c0b662b307c1ce34a54bae8a05 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 05:36:55 -0500 Subject: [PATCH 148/213] Use unscale args to check_redundant calls Added unscale arguments to the various check_redundant calls so that any error messages that are generated by inconsistent redundant points will be invariant to the unit scaling that is is in use. Also rescaled the units of dtbt_reset_period to [T ~> s] in the MOM_control_struct. All answers are bitwise identical, but in some rare debugging output will become consistent. --- src/core/MOM.F90 | 19 +++++++++--------- src/core/MOM_dynamics_split_RK2.F90 | 30 ++++++++++++++--------------- 2 files changed, 25 insertions(+), 24 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 07538cdec2..daa40ba052 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -296,7 +296,7 @@ module MOM logical :: use_diabatic_time_bug !< If true, uses the wrong calendar time for diabatic processes, !! as was done in MOM6 versions prior to February 2018. real :: dtbt_reset_period !< The time interval between dynamic recalculation of the - !! barotropic time step [s]. If this is negative dtbt is never + !! barotropic time step [T ~> s]. If this is negative dtbt is never !! calculated, and if it is 0, dtbt is calculated every step. type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. @@ -730,9 +730,10 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%debug) then if (cycle_start) & call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) - if (cycle_start) call check_redundant("Before steps ", u, v, G) + if (cycle_start) call check_redundant("Before steps ", u, v, G, unscale=US%L_T_to_m_s) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) - if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) + if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G, & + unscale=US%RZ_T_to_kg_m2s*US%L_T_to_m_s) endif call cpu_clock_end(id_clock_other) @@ -1498,7 +1499,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G, US, haloshift=0) - call check_redundant("Pre-diabatic ", u, v, G) + call check_redundant("Pre-diabatic ", u, v, G, unscale=US%L_T_to_m_s) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) endif @@ -1531,7 +1532,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) - call check_redundant("Pre-ALE ", u, v, G) + call check_redundant("Pre-ALE ", u, v, G, unscale=US%L_T_to_m_s) endif call cpu_clock_begin(id_clock_ALE) @@ -1586,7 +1587,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) - call check_redundant("Post-ALE ", u, v, G) + call check_redundant("Post-ALE ", u, v, G, unscale=US%L_T_to_m_s) endif ! Whenever thickness changes let the diag manager know, target grids @@ -1611,7 +1612,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) - call check_redundant("Post-diabatic ", u, v, G) + call check_redundant("Post-diabatic ", u, v, G, unscale=US%L_T_to_m_s) endif call disable_averaging(CS%diag) @@ -2186,7 +2187,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "only on information available at initialization. If 0, "//& "DTBT will be set every dynamics time step. The default "//& "is set by DT_THERM. This is only used if SPLIT is true.", & - units="s", default=default_val, do_not_read=(dtbt > 0.0)) + units="s", default=default_val, scale=US%s_to_T, do_not_read=(dtbt > 0.0)) endif call get_param(param_file, "MOM", "DT_OBC_SEG_UPDATE_OBGC", CS%dt_obc_seg_period, & @@ -2988,7 +2989,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, CS%pbv, calc_dtbt=calc_dtbt, cont_stencil=CS%cont_stencil) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) + CS%dtbt_reset_interval = real_to_time(US%T_to_s*CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e8909e24f9..1d7a70a55c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -406,8 +406,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) - call check_redundant("Start predictor u ", u, v, G) - call check_redundant("Start predictor uh ", uh, vh, G) + call check_redundant("Start predictor u ", u, v, G, unscale=US%L_T_to_m_s) + call check_redundant("Start predictor uh ", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) endif dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) @@ -543,10 +543,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call MOM_accel_chksum("pre-btstep accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) - call check_redundant("pre-btstep CS%CA ", CS%CAu_pred, CS%CAv_pred, G) - call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) - call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + call check_redundant("pre-btstep CS%CA ", CS%CAu_pred, CS%CAv_pred, G, unscale=US%L_T2_to_m_s2) + call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G, unscale=US%L_T2_to_m_s2) endif call cpu_clock_begin(id_clock_vertvisc) @@ -649,8 +649,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & symmetric=sym) - call check_redundant("Predictor 1 up", up, vp, G) - call check_redundant("Predictor 1 uh", uh, vh, G) + call check_redundant("Predictor 1 up", up, vp, G, unscale=US%L_T_to_m_s) + call check_redundant("Predictor 1 uh", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) endif ! up <- up + dt_pred d/dz visc d/dz up @@ -778,8 +778,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) - call check_redundant("Predictor up ", up, vp, G) - call check_redundant("Predictor uh ", uh, vh, G) + call check_redundant("Predictor up ", up, vp, G, unscale=US%L_T_to_m_s) + call check_redundant("Predictor uh ", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) endif ! diffu = horizontal viscosity terms (u_av) @@ -820,10 +820,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) - call check_redundant("corr pre-btstep CS%CA ", CS%CAu, CS%CAv, G) - call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) - call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + call check_redundant("corr pre-btstep CS%CA ", CS%CAu, CS%CAv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G, unscale=US%L_T2_to_m_s2) endif ! u_accel_bt = layer accelerations due to barotropic solver @@ -848,7 +848,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (showCallTree) call callTree_leave("btstep()") if (CS%debug) then - call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G) + call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G, unscale=US%L_T2_to_m_s2) endif ! u = u + dt*( u_bc_accel + u_accel_bt ) From 915679db09e612215b46a236c7c0e0e48a6cda0f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jan 2023 19:09:16 -0500 Subject: [PATCH 149/213] Document units of variables in MOM_spatial_means Added or amended comments to document the units of numerous internal variables and function arguments in MOM_spatial_means.F90. Only comments are changed, and all answers are bitwise identical. --- src/diagnostics/MOM_spatial_means.F90 | 245 +++++++++++++++++--------- 1 file changed, 163 insertions(+), 82 deletions(-) diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index 502475d3f3..ab1210c0f5 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -22,21 +22,33 @@ module MOM_spatial_means public :: global_volume_mean, global_mass_integral, global_mass_int_EFP public :: adjust_area_mean_to_zero +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + contains !> Return the global area mean of a variable. This uses reproducing sums. function global_area_mean(var, G, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to average - real, optional, intent(in) :: scale !< A rescaling factor for the variable - real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_area_mean + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the variable + !! that is reversed in the return value [a A-1 ~> 1] + real :: global_area_mean ! The mean of the variable in arbitrary unscaled units [a] or scaled units [A ~> a] ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor. + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] + real :: scalefac ! An overall scaling factor for the areas and variable [a m2 A-1 L-2 ~> 1] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -58,16 +70,23 @@ end function global_area_mean !> Return the global area mean of a variable. This uses reproducing sums. function global_area_mean_v(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: var !< The variable to average + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value + !! variable that converts it back to unscaled + !! (e.g., mks) units to enable the use of the + !! reproducing sums [a A-1 ~> 1], but is reversed + !! before output so that the return value has + !! the same units as var - real :: global_area_mean_v + real :: global_area_mean_v ! The mean of the variable in the same arbitrary units as var [A ~> a] ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] + real :: scalefac ! An overall scaling factor for the areas and variable [a m2 A-1 L-2 ~> 1] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -91,14 +110,22 @@ end function global_area_mean_v !> Return the global area mean of a variable on U grid. This uses reproducing sums. function global_area_mean_u(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: var !< The variable to average + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_area_mean_u + !! variable that converts it back to unscaled + !! (e.g., mks) units to enable the use of the + !! reproducing sums [a A-1 ~> 1], but is reversed + !! before output so that the return value has + !! the same units as var + real :: global_area_mean_u ! The mean of the variable in the same arbitrary units as var [A ~> a] - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] + real :: scalefac ! An overall scaling factor for the areas and variable [a m2 A-1 L-2 ~> 1] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -123,18 +150,24 @@ end function global_area_mean_u !! grid, but an alternate could be used instead. This uses reproducing sums. function global_area_integral(var, G, scale, area, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to integrate - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to integrate in + !! arbitrary, possibly rescaled units [A ~> a] + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: area !< The alternate area to use, including !! any required masking [L2 ~> m2]. real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_area_integral !< The returned area integral, usually in the units of var times [m2]. + !! variable that is reversed in the return value [a A-1 ~> 1] + real :: global_area_integral !< The returned area integral, usually in the units of var times an area, + !! [a m2] or [A m2 ~> a m2] depending on which optional arguments are provided ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor. + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -163,18 +196,28 @@ end function global_area_integral function global_layer_mean(var, h, G, GV, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real, dimension(SZK_(GV)) :: global_layer_mean + !! variable that is reversed in the return value [a A-1 ~> 1] + real, dimension(SZK_(GV)) :: global_layer_mean !< The mean of the variable in the arbitrary scaled [A] + !! or unscaled [a] units of var, depending on which optional + !! arguments are provided - real, dimension(G%isc:G%iec, G%jsc:G%jec, SZK_(GV)) :: tmpForSumming, weight + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(G%isc:G%iec,G%jsc:G%jec,SZK_(GV)) :: tmpForSumming ! An unscaled cell integral [a m3] + real, dimension(G%isc:G%iec,G%jsc:G%jec,SZK_(GV)) :: weight ! The volume of each cell, used as a weight [m3] type(EFP_type), dimension(2*SZK_(GV)) :: laysums - real, dimension(SZK_(GV)) :: global_temp_scalar, global_weight_scalar - real :: temp_scale ! A temporary scaling factor - real :: scalefac ! A scaling factor for the variable. + real, dimension(SZK_(GV)) :: global_temp_scalar ! The global integral of the tracer in each layer [a m3] + real, dimension(SZK_(GV)) :: global_weight_scalar ! The global integral of the volume of each layer [m3] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -202,18 +245,26 @@ function global_volume_mean(var, h, G, GV, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: var !< The variable being averaged + intent(in) :: var !< The variable being averaged in + !! arbitrary, possibly rescaled units [A ~> a] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_volume_mean !< The thickness-weighted average of var + !! variable that is reversed in the return value [a A-1 ~> 1] + real :: global_volume_mean !< The thickness-weighted average of var in the arbitrary scaled [A] or + !! unscaled [a] units of var, depending on which optional arguments are provided - real :: temp_scale ! A temporary scaling factor - real :: scalefac ! A scaling factor for the variable. - real :: weight_here - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming, sum_weight + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: weight_here ! The volume of a grid cell [m3] + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! The volume integral of the variable in a column [a m3] + real, dimension(SZI_(G),SZJ_(G)) :: sum_weight ! The volume of each column of water [m3] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -239,19 +290,25 @@ function global_mass_integral(h, G, GV, var, on_PE_only, scale, tmp_scale) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: var !< The variable being integrated - logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only - !! done on the local PE, and it is _not_ order invariant. - real, optional, intent(in) :: scale !< A rescaling factor for the variable + optional, intent(in) :: var !< The variable being integrated in + !! arbitrary, possibly rescaled units [A ~> a] + logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only done + !! on the local PE, and it is _not_ order invariant. + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value + !! variable that is reversed in the return value [a A-1 ~> 1] real :: global_mass_integral !< The mass-weighted integral of var (or 1) in - !! kg times the units of var + !! kg times the arbitrary units of var [kg a] or [kg A ~> kg a] - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor. - logical :: global_sum + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! The mass-weighted integral of the variable in a column [kg a] + real :: scalefac ! An overall scaling factor for the cell mass and variable [a kg A-1 H-1 L-2 ~> kg m-3 or 1] + real :: temp_scale ! A temporary scaling factor [1] or [a A-1 ~> 1] + logical :: global_sum ! If true do the sum globally, but if false only do the sum on the current PE. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -293,16 +350,21 @@ function global_mass_int_EFP(h, G, GV, var, on_PE_only, scale) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: var !< The variable being integrated + optional, intent(in) :: var !< The variable being integrated in + !! arbitrary, possibly rescaled units [A ~> a] logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only done !! on the local PE, but it is still order invariant. - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums type(EFP_type) :: global_mass_int_EFP !< The mass-weighted integral of var (or 1) in - !! kg times the units of var + !! kg times the arbitrary units of var [kg a] ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSum - real :: scalefac ! An overall scaling factor for the areas and variable. + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSum ! The mass-weighted integral of the variable in a column [kg a] + real :: scalefac ! An overall scaling factor for the cell mass and variable [a kg A-1 H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, isr, ier, jsr, jer is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -333,19 +395,25 @@ end function global_mass_int_EFP !! in a 1-d array using the local indexing. This uses reproducing sums. subroutine global_i_mean(array, i_mean, G, mask, scale, tmp_scale) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged - real, dimension(SZJ_(G)), intent(out) :: i_mean !< Global mean of array along its i-axis + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(SZJ_(G)), intent(out) :: i_mean !< Global mean of array along its i-axis [a] or [A ~> a] real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: mask !< An array used for weighting the i-mean - real, optional, intent(in) :: scale !< A rescaling factor for the output variable + optional, intent(in) :: mask !< An array used for weighting the i-mean [nondim] + real, optional, intent(in) :: scale !< A rescaling factor for the output variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A rescaling factor for the internal - !! calculations that is removed from the output + !! calculations that is removed from the output [a A-1 ~> 1] ! Local variables - type(EFP_type), allocatable, dimension(:) :: asum, mask_sum - real :: scalefac ! A scaling factor for the variable. - real :: unscale ! A factor for undoing any internal rescaling before output. - real :: mask_sum_r + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + type(EFP_type), allocatable, dimension(:) :: asum ! The masked sum of the variable in each row [a] + type(EFP_type), allocatable, dimension(:) :: mask_sum ! The sum of the mask values in each row [nondim] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: unscale ! A factor for undoing any internal rescaling before output [A a-1 ~> 1] + real :: mask_sum_r ! The sum of the mask values in a row [nondim] integer :: is, ie, js, je, idg_off, jdg_off integer :: i, j @@ -419,19 +487,25 @@ end subroutine global_i_mean !! in a 1-d array using the local indexing. This uses reproducing sums. subroutine global_j_mean(array, j_mean, G, mask, scale, tmp_scale) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged - real, dimension(SZI_(G)), intent(out) :: j_mean !< Global mean of array along its j-axis + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(SZI_(G)), intent(out) :: j_mean !< Global mean of array along its j-axis [a] or [A ~> a] real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: mask !< An array used for weighting the j-mean - real, optional, intent(in) :: scale !< A rescaling factor for the output variable + real, optional, intent(in) :: scale !< A rescaling factor for the output variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A rescaling factor for the internal - !! calculations that is removed from the output + !! calculations that is removed from the output [a A-1 ~> 1] ! Local variables - type(EFP_type), allocatable, dimension(:) :: asum, mask_sum - real :: mask_sum_r - real :: scalefac ! A scaling factor for the variable. - real :: unscale ! A factor for undoing any internal rescaling before output. + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + type(EFP_type), allocatable, dimension(:) :: asum ! The masked sum of the variable in each row [a] + type(EFP_type), allocatable, dimension(:) :: mask_sum ! The sum of the mask values in each row [nondim] + real :: mask_sum_r ! The sum of the mask values in a row [nondim] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: unscale ! A factor for undoing any internal rescaling before output [A a-1 ~> 1] integer :: is, ie, js, je, idg_off, jdg_off integer :: i, j @@ -504,16 +578,23 @@ end subroutine global_j_mean !> Adjust 2d array such that area mean is zero without moving the zero contour subroutine adjust_area_mean_to_zero(array, G, scaling, unit_scale) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: array !< 2D array to be adjusted - real, optional, intent(out) :: scaling !< The scaling factor used - real, optional, intent(in) :: unit_scale !< A rescaling factor for the variable + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: array !< 2D array to be adjusted in + !! arbitrary, possibly rescaled units [A ~> a] + real, optional, intent(out) :: scaling !< The scaling factor used [nondim] + real, optional, intent(in) :: unit_scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums ! Local variables - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: posVals, negVals, areaXposVals, areaXnegVals + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: posVals, negVals ! The positive or negative values in a cell or 0 [a] + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: areaXposVals, areaXnegVals ! The cell area integral of the values [m2 a] + type(EFP_type), dimension(2) :: areaInt_EFP ! An EFP version integral of the values on the current PE [m2 a] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: I_scalefac ! The Adcroft reciprocal of scalefac [A a-1 ~> 1] + real :: areaIntPosVals, areaIntNegVals ! The global area integral of the positive and negative values [m2 a] + real :: posScale, negScale ! The scaling factor to apply to positive or negative values [nondim] integer :: i,j - type(EFP_type), dimension(2) :: areaInt_EFP - real :: scalefac ! A scaling factor for the variable. - real :: I_scalefac ! The Adcroft reciprocal of scalefac - real :: areaIntPosVals, areaIntNegVals, posScale, negScale scalefac = 1.0 ; if (present(unit_scale)) scalefac = unit_scale I_scalefac = 0.0 ; if (scalefac /= 0.0) I_scalefac = 1.0 / scalefac From ff15a765e6aac79c6c57102d9921b685ad4217ef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 09:11:59 -0500 Subject: [PATCH 150/213] Document units of variables in MOM_checksums Added or amended comments to document the units of numerous internal variables and function arguments in MOM_checksums.F90. Only comments are changed, and all answers are bitwise identical. --- src/framework/MOM_checksums.F90 | 502 +++++++++++++++++++------------- 1 file changed, 302 insertions(+), 200 deletions(-) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index aae3d3f5dc..00e4ba4918 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -21,6 +21,13 @@ module MOM_checksums public :: hchksum_pair, uvchksum, Bchksum_pair public :: MOM_checksums_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + !> Checksums a pair of arrays (2d or 3d) staggered at tracer points interface hchksum_pair module procedure chksum_pair_h_2d, chksum_pair_h_3d @@ -96,14 +103,20 @@ module MOM_checksums !> Checksum a scalar field (consistent with array checksums) subroutine chksum0(scalar, mesg, scale, logunit) - real, intent(in) :: scalar !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message - real, optional, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scalar !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real :: scaling !< Explicit rescaling factor + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real :: scaling !< Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit - real :: rs !< Rescaled scalar + real :: rs !< Rescaled scalar [a] integer :: bc !< Scalar bitcount if (checkForNaNs .and. is_NaN(scalar)) & @@ -129,16 +142,22 @@ end subroutine chksum0 !> Checksum a 1d array (typically a column). subroutine zchksum(array, mesg, scale, logunit) - real, dimension(:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, dimension(:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, allocatable, dimension(:) :: rescaled_array - real :: scaling + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, allocatable, dimension(:) :: rescaled_array ! The array with scaling undone [a] + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: k - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0 if (checkForNaNs) then @@ -174,8 +193,10 @@ subroutine zchksum(array, mesg, scale, logunit) contains integer function subchk(array, scale) - real, dimension(:), intent(in) :: array !< The array to be checksummed - real, intent(in) :: scale !< A scaling factor for this array. + real, dimension(:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: k, bc subchk = 0 do k=LBOUND(array, 1), UBOUND(array, 1) @@ -186,10 +207,10 @@ integer function subchk(array, scale) end function subchk subroutine subStats(array, aMean, aMin, aMax) - real, dimension(:), intent(in) :: array !< The array to be checksummed - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, dimension(:), intent(in) :: array !< The array to be checksummed [a] + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: k, n @@ -210,18 +231,21 @@ subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, & scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert these arrays back to unscaled + !! units for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -261,19 +285,21 @@ subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, & scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging - - logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging + logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -312,21 +338,27 @@ end subroutine chksum_pair_h_3d !> Checksums a 2d array staggered at tracer points. subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logunit) - type(hor_index_type), target, intent(in) :: HI_m !< Horizontal index bounds of the model grid - real, dimension(HI_m%isd:,HI_m%jsd:), target, intent(in) :: array_m !< Field array on the model grid - character(len=*), intent(in) :: mesg !< An identifying message + type(hor_index_type), target, intent(in) :: HI_m !< Horizontal index bounds of the model grid + real, dimension(HI_m%isd:,HI_m%jsd:), target, intent(in) :: array_m !< Field array on the model grid in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners @@ -415,10 +447,12 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu contains integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di @@ -431,10 +465,10 @@ end function subchk subroutine subStats(HI, array, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed [a] + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n @@ -460,22 +494,25 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: sym logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -520,21 +557,24 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -576,22 +616,28 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type real, dimension(HI_m%IsdB:,HI_m%JsdB:), & - target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the !! full symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, Is, Js - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -692,10 +738,12 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -709,12 +757,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n, IsB, JsB @@ -742,20 +790,23 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:), target, intent(in) :: arrayU !< The u-component array to be checksummed - real, dimension(HI%isd:,HI%JsdB:), target, intent(in) :: arrayV !< The v-component array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:), target, intent(in) :: arrayU !< The u-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%JsdB:), target, intent(in) :: arrayV !< The v-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for these arrays. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert these arrays back to unscaled + !! units for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe a - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:), pointer :: arrayU_in, arrayV_in + real, dimension(:,:), pointer :: arrayU_in, arrayV_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -797,20 +848,23 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:,:), target, intent(in) :: arrayU !< The u-component array to be checksummed - real, dimension(HI%isd:,HI%JsdB:,:), target, intent(in) :: arrayV !< The v-component array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:,:), target, intent(in) :: arrayU !< The u-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%JsdB:,:), target, intent(in) :: arrayV !< The v-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for these arrays. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert these arrays back to unscaled + !! units for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe a !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:,:), pointer :: arrayU_in, arrayV_in + real, dimension(:,:,:), pointer :: arrayU_in, arrayV_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -850,23 +904,29 @@ end subroutine chksum_uv_3d !> Checksums a 2d array staggered at C-grid u points. subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) - type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%IsdB:,HI_m%jsd:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type + real, dimension(HI_m%IsdB:,HI_m%jsd:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, Is - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -981,10 +1041,12 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -998,12 +1060,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n, IsB @@ -1029,22 +1091,28 @@ end subroutine chksum_u_2d subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isd:,HI_m%JsdB:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%isd:,HI_m%JsdB:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, Js - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1159,10 +1227,12 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1176,12 +1246,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n, JsB @@ -1206,20 +1276,26 @@ end subroutine chksum_v_2d !> Checksums a 3d array staggered at tracer points. subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isd:,HI_m%jsd:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%isd:,HI_m%jsd:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners @@ -1311,10 +1387,12 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 do k=LBOUND(array,3),UBOUND(array,3) ; do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di @@ -1327,10 +1405,10 @@ end function subchk subroutine subStats(HI, array, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed [a] + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, k, n @@ -1355,22 +1433,28 @@ end subroutine chksum_h_3d subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%IsdB:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%IsdB:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k, Is, Js - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1478,10 +1562,12 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1495,12 +1581,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, k, n, IsB, JsB @@ -1526,22 +1612,28 @@ end subroutine chksum_B_3d subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isdB:,HI_m%Jsd:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%isdB:,HI_m%Jsd:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k, Is - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1656,10 +1748,12 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1673,12 +1767,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, k, n, IsB @@ -1703,25 +1797,31 @@ end subroutine chksum_u_3d !> Checksums a 3d array staggered at C-grid v points. subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) - type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isd:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type + real, dimension(HI_m%isd:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k, Js integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] logical :: do_corners, sym, sym_stats integer :: turns ! Quarter turns from input to model grid @@ -1834,10 +1934,12 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1852,12 +1954,12 @@ end function subchk !subroutine subStats(HI, array, mesg, sym_stats) subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Mean of array over domain - real, intent(out) :: aMin !< Minimum of array over domain - real, intent(out) :: aMax !< Maximum of array over domain + real, intent(out) :: aMean !< Mean of array over domain [a] + real, intent(out) :: aMin !< Minimum of array over domain [a] + real, intent(out) :: aMax !< Maximum of array over domain [a] integer :: i, j, k, n, JsB @@ -1884,7 +1986,7 @@ end subroutine chksum_v_3d !> chksum1d does a checksum of a 1-dimensional array. subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) - real, dimension(:), intent(in) :: array !< The array to be summed (index starts at 1). + real, dimension(:), intent(in) :: array !< The array to be summed (index starts at 1) [abitrary]. character(len=*), intent(in) :: mesg !< An identifying message. integer, optional, intent(in) :: start_i !< The starting index for the sum (default 1) integer, optional, intent(in) :: end_i !< The ending index for the sum (default all) @@ -1892,8 +1994,8 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) !! and list the root_PE value (default true) integer :: is, ie, i, bc, sum1, sum_bc - real :: sum - real, allocatable :: sum_here(:) + real :: sum ! The global sum of the array [arbitrary] + real, allocatable :: sum_here(:) ! The sum on each PE [arbitrary] logical :: compare integer :: pe_num ! pe number of the data integer :: nPEs ! Total number of processsors @@ -1943,11 +2045,11 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg) - real, dimension(:,:), intent(in) :: array !< The array to be checksummed + real, dimension(:,:), intent(in) :: array !< The array to be checksummed [arbitrary] character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,i,j,sum1,bc - real :: sum + real :: sum ! The global sum of the array [arbitrary] xs = LBOUND(array,1) ; xe = UBOUND(array,1) ys = LBOUND(array,2) ; ye = UBOUND(array,2) @@ -1971,11 +2073,11 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg) - real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed + real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed [arbitrary] character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 - real :: sum + real :: sum ! The global sum of the array [arbitrary] xs = LBOUND(array,1) ; xe = UBOUND(array,1) ys = LBOUND(array,2) ; ye = UBOUND(array,2) @@ -1999,7 +2101,7 @@ end subroutine chksum3d !> This function returns .true. if x is a NaN, and .false. otherwise. function is_NaN_0d(x) - real, intent(in) :: x !< The value to be checked for NaNs. + real, intent(in) :: x !< The value to be checked for NaNs [arbitrary] logical :: is_NaN_0d !is_NaN_0d = (((x < 0.0) .and. (x >= 0.0)) .or. & @@ -2015,7 +2117,7 @@ end function is_NaN_0d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) - real, dimension(:), intent(in) :: x !< The array to be checked for NaNs. + real, dimension(:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] logical, optional, intent(in) :: skip_mpp !< If true, only check this array only !! on the local PE (default false). logical :: is_NaN_1d @@ -2038,7 +2140,7 @@ end function is_NaN_1d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_2d(x) - real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs. + real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] logical :: is_NaN_2d integer :: i, j, n @@ -2055,7 +2157,7 @@ end function is_NaN_2d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_3d(x) - real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs. + real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] logical :: is_NaN_3d integer :: i, j, k, n @@ -2078,9 +2180,9 @@ end function is_NaN_3d !> Compute the field checksum of a scalar. function rotated_field_chksum_real_0d(field, pelist, mask_val, turns) & result(chksum) - real, intent(in) :: field !< Input scalar + real, intent(in) :: field !< Input scalar [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of scalar @@ -2093,9 +2195,9 @@ end function rotated_field_chksum_real_0d !> Compute the field checksum of a 1d field. function rotated_field_chksum_real_1d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:), intent(in) :: field !< Input array + real, dimension(:), intent(in) :: field !< Input array [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array @@ -2108,14 +2210,14 @@ end function rotated_field_chksum_real_1d !> Compute the field checksum of a rotated 2d field. function rotated_field_chksum_real_2d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:,:), intent(in) :: field !< Unrotated input field + real, dimension(:,:), intent(in) :: field !< Unrotated input field [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [arbitrary] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 @@ -2135,14 +2237,14 @@ end function rotated_field_chksum_real_2d !> Compute the field checksum of a rotated 3d field. function rotated_field_chksum_real_3d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:,:,:), intent(in) :: field !< Unrotated input field + real, dimension(:,:,:), intent(in) :: field !< Unrotated input field [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [arbitrary] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 @@ -2162,14 +2264,14 @@ end function rotated_field_chksum_real_3d !> Compute the field checksum of a rotated 4d field. function rotated_field_chksum_real_4d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:,:,:,:), intent(in) :: field !< Unrotated input field + real, dimension(:,:,:,:), intent(in) :: field !< Unrotated input field [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [arbitrary] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 @@ -2268,9 +2370,9 @@ end subroutine chk_sum_msg2 subroutine chk_sum_msg3(fmsg, aMean, aMin, aMax, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller - real, intent(in) :: aMean !< The mean value of the array - real, intent(in) :: aMin !< The minimum value of the array - real, intent(in) :: aMax !< The maximum value of the array + real, intent(in) :: aMean !< The mean value of the array [arbitrary] + real, intent(in) :: aMin !< The minimum value of the array [arbitrary] + real, intent(in) :: aMax !< The maximum value of the array [arbitrary] integer, intent(in) :: iounit !< Checksum logger IO unit ! NOTE: We add zero to aMin and aMax to remove any negative zeros. @@ -2284,8 +2386,8 @@ end subroutine chk_sum_msg3 !! only thing that it does is to log the version of this module. subroutine MOM_checksums_init(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_checksums" ! This module's name. call log_version(param_file, mdl, version) @@ -2303,7 +2405,7 @@ end subroutine chksum_error !> Does a bitcount of a number by first casting to an integer and then using BTEST !! to check bit by bit integer function bitcount(x) - real, intent(in) :: x !< Number to be bitcount + real, intent(in) :: x !< Number to be bitcount [arbitrary] integer, parameter :: xk = kind(x) !< Kind type of x From 0ab7744d4b6890383196e23a979426e317ca9332 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 09:12:38 -0500 Subject: [PATCH 151/213] Document units of arguments in MOM_io Added schematic unit descriptions to the comments describing the arguments to the MOM_io routines, and clearly indicating when they work with rescaled variables. Only comments are changed, and all answers are bitwise identical. --- src/framework/MOM_io.F90 | 196 ++++++++++++++++++++++++--------------- 1 file changed, 119 insertions(+), 77 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 6c2dc9df34..1dc6916c2c 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -148,8 +148,9 @@ module MOM_io character(len=64) :: cmor_field_name !< CMOR name character(len=64) :: cmor_units !< CMOR physical dimensions of the variable character(len=240) :: cmor_longname !< CMOR long name of the variable - real :: conversion !< for unit conversions, such as needed to - !! convert from intensive to extensive + real :: conversion !< for unit conversions, such as needed to convert + !! from intensive to extensive [various] or [a A-1 ~> 1] + !! to undo internal dimensional rescaling character(len=32) :: dim_names(5) !< The names in the file of the axes for this variable integer :: position = -1 !< An integer encoding the horizontal position, it may !! CENTER, CORNER, EAST_FACE, NORTH_FACE, or 0. @@ -166,7 +167,7 @@ module MOM_io integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1 !! if they increase downward. The default, 0, is ignored. integer :: ax_size = 0 !< The number of elements in this axis - real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis. + real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis [arbitrary] end type axis_info !> Type that stores for a global file attribute @@ -178,6 +179,13 @@ module MOM_io integer, public :: stdout = stdout_iso !< standard output unit integer, public :: stderr = stderr_iso !< standard output unit +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + contains !> `create_MOM_file` wrapper for the legacy file handle, `file_type`. @@ -271,11 +279,12 @@ subroutine create_MOM_file(IO_handle, filename, vars, novars, fields, & integer :: num_extra_dims ! The number of extra possible dimensions from extra_axes integer :: isg, ieg, jsg, jeg, IsgB, IegB, JsgB, JegB integer :: var_periods, num_periods=0 - real, dimension(:), allocatable :: axis_val + real, dimension(:), allocatable :: axis_val ! Axis label values [various] real, pointer, dimension(:) :: & - gridLatT => NULL(), & ! The latitude or longitude of T or B points for - gridLatB => NULL(), & ! the purpose of labeling the output axes. - gridLonT => NULL(), gridLonB => NULL() + gridLatT => NULL(), & ! The latitude of T or B points for the purpose of labeling + gridLatB => NULL(), & ! the output axes, often in units of [degrees_N] or [km] or [m]. + gridLonT => NULL(), & ! The longitude of T or B points for the purpose of labeling + gridLonB => NULL() ! the output axes, often in units of [degrees_E] or [km] or [m]. character(len=40) :: time_units, x_axis_units, y_axis_units character(len=8) :: t_grid, t_grid_read character(len=64) :: ax_name(5) ! The axis names of a variable @@ -870,11 +879,12 @@ end subroutine read_var_sizes subroutine read_variable_0d(filename, varname, var, ncid_in, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: varname !< The variable name of the data in the file - real, intent(inout) :: var !< The scalar into which to read the data + real, intent(inout) :: var !< The scalar into which to read the data in arbitrary units [A ~> a] integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the !! file is opened and closed within this routine - real, optional, intent(in) :: scale !< A scaling factor that the variable is - !! multiplied by before it is returned + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: varid, ncid, rc character(len=256) :: hdr @@ -907,11 +917,12 @@ end subroutine read_variable_0d subroutine read_variable_1d(filename, varname, var, ncid_in, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: varname !< The variable name of the data in the file - real, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data + real, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data in arbitrary units [A ~> a] integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the !! file is opened and closed within this routine - real, optional, intent(in) :: scale !< A scaling factor that the variable is - !! multiplied by before it is returned + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: varid, ncid, rc character(len=256) :: hdr @@ -1027,7 +1038,7 @@ end subroutine read_variable_1d_int subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) character(len=*), intent(in) :: filename !< Name of file to be read character(len=*), intent(in) :: varname !< Name of variable to be read - real, intent(out) :: var(:,:) !< Output array of variable + real, intent(out) :: var(:,:) !< Output array of variable [arbitrary] integer, optional, intent(in) :: start(:) !< Starting index on each axis. integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. @@ -1360,7 +1371,7 @@ end subroutine read_attribute_int64 subroutine read_attribute_real(filename, attname, att_val, varname, found, all_read, ncid_in) character(len=*), intent(in) :: filename !< Name of the file to read character(len=*), intent(in) :: attname !< Name of the attribute to read - real, intent(out) :: att_val !< The value of the attribute + real, intent(out) :: att_val !< The value of the attribute [arbitrary] character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will !! be read. If missing, read a global attribute. logical, optional, intent(out) :: found !< Returns true if the attribute is found @@ -1604,6 +1615,7 @@ function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_na character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name real , optional, intent(in) :: conversion !< for unit conversions, such as needed to !! convert from intensive to extensive + !! [various] or [a A-1 ~> 1] character(len=*), optional, intent(in) :: caller !< The calling routine for error messages integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position !! of this variable if it has such dimensions. @@ -1656,6 +1668,7 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & real , optional, intent(in) :: conversion !< A multiplicative factor for unit conversions, !! such as needed to convert from intensive to !! extensive or dimensional consistency testing + !! [various] or [a A-1 ~> 1] character(len=*), optional, intent(in) :: caller !< The calling routine for error messages integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position !! of this variable if it has such dimensions. @@ -1741,7 +1754,7 @@ subroutine set_axis_info(axis, name, units, longname, ax_size, ax_data, cartesia character(len=*), optional, intent(in) :: units !< The units of the axis labels character(len=*), optional, intent(in) :: longname !< Long name of the axis variable integer, optional, intent(in) :: ax_size !< The number of elements in this axis - real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis + real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis [arbitrary] character(len=*), optional, intent(in) :: cartesian !< A variable indicating which direction this axis !! axis corresponds with. Valid values !! include 'X', 'Y', 'Z', 'T', and 'N' (the default) for none. @@ -1801,7 +1814,7 @@ subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) character(len=*), intent(out), optional :: cartesian !< The cartesian attribute !! of the axis [X,Y,Z,T]. integer, intent(out), optional :: ax_size !< The size of the axis. - real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. + real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data [arbitrary] if (present(ax_data)) then if (allocated(ax_data)) deallocate(ax_data) @@ -1871,6 +1884,7 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & character(len=*), optional, intent(out) :: cmor_longname !< CMOR long name real , optional, intent(out) :: conversion !< for unit conversions, such as needed to !! convert from intensive to extensive + !! [various] or [a A-1 ~> 1] character(len=*), optional, intent(in) :: caller !< calling routine? integer, optional, intent(out) :: position !< A coded integer indicating the horizontal position !! of this variable if it has such dimensions. @@ -1921,9 +1935,11 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, intent(inout) :: data !< Field value + real, intent(inout) :: data !< Field value in arbitrary units [A ~> a] integer, optional, intent(in) :: timelevel !< Time level to read in file - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition logical, optional, intent(in) :: global_file !< If true, read from a single file logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored @@ -1952,9 +1968,11 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, dimension(:), intent(inout) :: data !< Field value + real, dimension(:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] integer, optional, intent(in) :: timelevel !< Time level to read in file - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition logical, optional, intent(in) :: global_file !< If true, read from a single file logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored @@ -1983,17 +2001,19 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, dimension(:,:), intent(inout) :: data !< Field value + real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition integer, optional, intent(in) :: timelevel !< Time level to read in file integer, optional, intent(in) :: position !< Grid positioning flag - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] logical, optional, intent(in) :: global_file !< If true, read from a single file logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored !! as 4d arrays in the file. integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: data_in(:,:) ! Field array on the input grid + real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a] turns = MOM_domain%turns if (turns == 0) then @@ -2018,7 +2038,7 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ no_domain, scale, turns) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, dimension(:,:), intent(inout) :: data !< Field value + real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] integer, dimension(:), intent(in) :: start !< Starting index for each axis. !! In 2d, start(3:4) must be 1. integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis. @@ -2026,12 +2046,14 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition logical, optional, intent(in) :: no_domain !< If true, field does not use !! domain decomposion. - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer, optional, intent(in) :: turns !< Number of quarter turns from !! input to model grid integer :: qturns ! Number of quarter turns - real, allocatable :: data_in(:,:) ! Field array on the input grid + real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a] qturns = 0 if (present(turns)) qturns = modulo(turns, 4) @@ -2056,17 +2078,19 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, dimension(:,:,:), intent(inout) :: data !< Field value + real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition integer, optional, intent(in) :: timelevel !< Time level to read in file integer, optional, intent(in) :: position !< Grid positioning flag - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] logical, optional, intent(in) :: global_file !< If true, read from a single file logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored !! as 4d arrays in the file. integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: data_in(:,:,:) ! Field array on the input grid + real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a] turns = MOM_domain%turns if (turns == 0) then @@ -2091,15 +2115,17 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, dimension(:,:,:,:), intent(inout) :: data !< Field value + real, dimension(:,:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition integer, optional, intent(in) :: timelevel !< Time level to read in file integer, optional, intent(in) :: position !< Grid positioning flag - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] logical, optional, intent(in) :: global_file !< If true, read from a single file integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid + real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid in arbitrary units [A ~> a] turns = MOM_domain%turns @@ -2127,16 +2153,18 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: u_fieldname !< Field variable name in u character(len=*), intent(in) :: v_fieldname !< Field variable name in v - real, dimension(:,:), intent(inout) :: u_data !< Field value in u - real, dimension(:,:), intent(inout) :: v_data !< Field value in v + real, dimension(:,:), intent(inout) :: u_data !< Field value at u points in arbitrary units [A ~> a] + real, dimension(:,:), intent(inout) :: v_data !< Field value at v points in arbitrary units [A ~> a] type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition integer, optional, intent(in) :: timelevel !< Time level to read in file integer, optional, intent(in) :: stagger !< Grid staggering flag logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid + real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid in arbitrary units [A ~> a] turns = MOM_Domain%turns if (turns == 0) then @@ -2168,16 +2196,18 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: u_fieldname !< Field variable name in u character(len=*), intent(in) :: v_fieldname !< Field variable name in v - real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u - real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v + real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u in arbitrary units [A ~> a] + real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v in arbitrary units [A ~> a] type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition integer, optional, intent(in) :: timelevel !< Time level to read in file integer, optional, intent(in) :: stagger !< Grid staggering flag logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid + real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid in arbitrary units [A ~> a] turns = MOM_Domain%turns if (turns == 0) then @@ -2208,16 +2238,18 @@ subroutine MOM_write_field_legacy_4d(IO_handle, field_md, MOM_domain, field, tst type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition - real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write - real, optional, intent(in) :: tstamp !< Model timestamp + real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) - real, optional, intent(in) :: fill_value !< Missing data fill value + real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a] integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data - real, optional, intent(in) :: scale !< A scaling factor that the field is - !! multiplied by before it is written + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output - real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units or rescaled - real :: scale_fac ! A scaling factor to use before writing the array + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [a] or + ! rescaled [A ~> a] then [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) @@ -2243,16 +2275,19 @@ subroutine MOM_write_field_legacy_3d(IO_handle, field_md, MOM_domain, field, tst type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition - real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write - real, optional, intent(in) :: tstamp !< Model timestamp + real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) - real, optional, intent(in) :: fill_value !< Missing data fill value + real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a] integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data - real, optional, intent(in) :: scale !< A scaling factor that the field is - !! multiplied by before it is written + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output - real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units or rescaled - real :: scale_fac ! A scaling factor to use before writing the array + + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [a] or + ! rescaled [A ~> a] then [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) @@ -2278,16 +2313,19 @@ subroutine MOM_write_field_legacy_2d(IO_handle, field_md, MOM_domain, field, tst type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition - real, dimension(:,:), intent(inout) :: field !< Unrotated field to write - real, optional, intent(in) :: tstamp !< Model timestamp + real, dimension(:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) real, optional, intent(in) :: fill_value !< Missing data fill value integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data - real, optional, intent(in) :: scale !< A scaling factor that the field is - !! multiplied by before it is written + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output - real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units - real :: scale_fac ! A scaling factor to use before writing the array + + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [a] or + ! rescaled [A ~> a] then [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) @@ -2311,14 +2349,16 @@ end subroutine MOM_write_field_legacy_2d subroutine MOM_write_field_legacy_1d(IO_handle, field_md, field, tstamp, fill_value, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata - real, dimension(:), intent(in) :: field !< Field to write - real, optional, intent(in) :: tstamp !< Model timestamp - real, optional, intent(in) :: fill_value !< Missing data fill value - real, optional, intent(in) :: scale !< A scaling factor that the field is - !! multiplied by before it is written + real, dimension(:), intent(in) :: field !< Field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + real, optional, intent(in) :: fill_value !< Missing data fill value [a] + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output - real, dimension(:), allocatable :: array ! A rescaled copy of field - real :: scale_fac ! A scaling factor to use before writing the array + + real, dimension(:), allocatable :: array ! A rescaled copy of field [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] integer :: i scale_fac = 1.0 ; if (present(scale)) scale_fac = scale @@ -2341,12 +2381,14 @@ end subroutine MOM_write_field_legacy_1d subroutine MOM_write_field_legacy_0d(IO_handle, field_md, field, tstamp, fill_value, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata - real, intent(in) :: field !< Field to write - real, optional, intent(in) :: tstamp !< Model timestamp - real, optional, intent(in) :: fill_value !< Missing data fill value - real, optional, intent(in) :: scale !< A scaling factor that the field is - !! multiplied by before it is written - real :: scaled_val ! A rescaled copy of field + real, intent(in) :: field !< Field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + real, optional, intent(in) :: fill_value !< Missing data fill value [a] + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output + + real :: scaled_val ! A rescaled copy of field [a] scaled_val = field if (present(scale)) scaled_val = scale*field @@ -2673,9 +2715,9 @@ subroutine get_var_axes_info(filename, fieldname, axes_info) character(len=128) :: dim_name(4) integer, dimension(1) :: start, count !! cartesian axis data - real, allocatable, dimension(:) :: x - real, allocatable, dimension(:) :: y - real, allocatable, dimension(:) :: z + real, allocatable, dimension(:) :: x ! x-axis labels, often [degrees_E] or [km] or [m] + real, allocatable, dimension(:) :: y ! y-axis labels, often [degrees_N] or [km] or [m] + real, allocatable, dimension(:) :: z ! vertical axis labels [various], often [m] or [kg m-3] call open_file_to_read(filename, ncid, success=success) From 15ce275f80bc4e5b0375966dfb47969ecbd9afb3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 09:13:15 -0500 Subject: [PATCH 152/213] Document units of arguments in MOM_restart Added schematic unit descriptions to the comments describing the arguments to the MOM_restart routines, and clearly indicating when they work with rescaled variables. Only comments are changed, and all answers are bitwise identical. --- src/framework/MOM_restart.F90 | 125 ++++++++++++++++++++++------------ 1 file changed, 81 insertions(+), 44 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 2939a7d907..24ba0fa76b 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -27,29 +27,36 @@ module MOM_restart public restart_files_exist, determine_is_new_run, is_new_run public register_restart_field_as_obsolete, register_restart_pair +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + !> A type for making arrays of pointers to 4-d arrays type p4d - real, dimension(:,:,:,:), pointer :: p => NULL() !< A pointer to a 4d array + real, dimension(:,:,:,:), pointer :: p => NULL() !< A pointer to a 4d array in arbitrary rescaled units [A ~> a] end type p4d !> A type for making arrays of pointers to 3-d arrays type p3d - real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3d array + real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3d array in arbitrary rescaled units [A ~> a] end type p3d !> A type for making arrays of pointers to 2-d arrays type p2d - real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2d array + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2d array in arbitrary rescaled units [A ~> a] end type p2d !> A type for making arrays of pointers to 1-d arrays type p1d - real, dimension(:), pointer :: p => NULL() !< A pointer to a 1d array + real, dimension(:), pointer :: p => NULL() !< A pointer to a 1d array in arbitrary rescaled units [A ~> a] end type p1d !> A type for making arrays of pointers to scalars type p0d - real, pointer :: p => NULL() !< A pointer to a scalar + real, pointer :: p => NULL() !< A pointer to a scalar in arbitrary rescaled units [A ~> a] end type p0d !> A structure with information about a single restart field @@ -62,8 +69,8 @@ module MOM_restart character(len=32) :: var_name !< A name by which a variable may be queried. real :: conv = 1.0 !< A factor by which a restart field should be multiplied before it !! is written to a restart file, usually to convert it to MKS or - !! other standard units. When read, the restart field is multiplied - !! by the Adcroft reciprocal of this factor. + !! other standard units [a A-1 ~> 1]. When read, the restart field + !! is multiplied by the Adcroft reciprocal of this factor. end type field_restart !> A structure to store information about restart fields that are no longer used @@ -171,12 +178,13 @@ end subroutine register_restart_field_as_obsolete subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -208,12 +216,13 @@ end subroutine register_restart_field_ptr3d subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -245,12 +254,13 @@ end subroutine register_restart_field_ptr4d subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -281,12 +291,13 @@ end subroutine register_restart_field_ptr2d !> Register a 1-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -317,12 +328,13 @@ end subroutine register_restart_field_ptr1d !> Register a 0-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS, conversion) real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -355,13 +367,15 @@ end subroutine register_restart_field_ptr0d subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, & mandatory, CS, conversion) real, dimension(:,:), target, intent(in) :: a_ptr !< First field pointer + !! in arbitrary rescaled units [A ~> a] real, dimension(:,:), target, intent(in) :: b_ptr !< Second field pointer + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. call lock_check(CS, a_desc) @@ -378,14 +392,16 @@ end subroutine register_restart_pair_ptr2d !> Register a pair of rotationally equivalent 3d restart fields subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, & mandatory, CS, conversion) - real, dimension(:,:,:), target, intent(in) :: a_ptr !< First field pointer - real, dimension(:,:,:), target, intent(in) :: b_ptr !< Second field pointer + real, dimension(:,:,:), target, intent(in) :: a_ptr !< First field pointer + !! in arbitrary rescaled units [A ~> a] + real, dimension(:,:,:), target, intent(in) :: b_ptr !< Second field pointer + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. call lock_check(CS, a_desc) @@ -403,13 +419,15 @@ end subroutine register_restart_pair_ptr3d subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, & mandatory, CS, conversion) real, dimension(:,:,:,:), target, intent(in) :: a_ptr !< First field pointer + !! in arbitrary rescaled units [A ~> a] real, dimension(:,:,:,:), target, intent(in) :: b_ptr !< Second field pointer + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. call lock_check(CS, a_desc) @@ -430,6 +448,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units hor_grid, z_grid, t_grid) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -437,7 +456,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -462,6 +481,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units hor_grid, z_grid, t_grid) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -469,7 +489,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -494,6 +514,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units hor_grid, z_grid, t_grid) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -501,7 +522,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, '1' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -528,6 +549,7 @@ end subroutine register_restart_field_2d subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units, conversion, & hor_grid, z_grid, t_grid) real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -535,7 +557,7 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, '1' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -562,6 +584,7 @@ end subroutine register_restart_field_1d subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units, conversion, & t_grid) real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -569,7 +592,7 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent type(vardesc) :: vd @@ -622,7 +645,7 @@ end function query_initialized_name !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_0d(f_ptr, CS) result(query_initialized) - real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried + real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -646,7 +669,7 @@ end function query_initialized_0d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_1d(f_ptr, CS) result(query_initialized) - real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried + real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -671,7 +694,7 @@ end function query_initialized_1d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_2d(f_ptr, CS) result(query_initialized) real, dimension(:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -696,7 +719,7 @@ end function query_initialized_2d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_3d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -721,7 +744,7 @@ end function query_initialized_3d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_4d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -746,7 +769,7 @@ end function query_initialized_4d !> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) - real, target, intent(in) :: f_ptr !< The field that is being queried + real, target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -779,7 +802,7 @@ end function query_initialized_0d_name !! name has been initialized from a restart file. function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -812,7 +835,7 @@ end function query_initialized_1d_name !! name has been initialized from a restart file. function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -845,7 +868,7 @@ end function query_initialized_2d_name !! name has been initialized from a restart file. function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -878,7 +901,7 @@ end function query_initialized_3d_name !! name has been initialized from a restart file. function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -929,7 +952,7 @@ end subroutine set_initialized_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_0d_name(f_ptr, name, CS) - real, target, intent(in) :: f_ptr !< The variable that has been initialized + real, target, intent(in) :: f_ptr !< The variable that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -954,7 +977,7 @@ end subroutine set_initialized_0d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_1d_name(f_ptr, name, CS) real, dimension(:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -979,7 +1002,7 @@ end subroutine set_initialized_1d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_2d_name(f_ptr, name, CS) real, dimension(:,:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -1004,7 +1027,7 @@ end subroutine set_initialized_2d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_3d_name(f_ptr, name, CS) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -1029,7 +1052,7 @@ end subroutine set_initialized_3d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_4d_name(f_ptr, name, CS) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -1058,6 +1081,7 @@ end subroutine set_initialized_4d_name subroutine only_read_restart_field_4d(varname, f_ptr, G, CS, position, filename, directory, success, scale) character(len=*), intent(in) :: varname !< The variable name to be used in the restart file real, dimension(:,:,:,:), intent(inout) :: f_ptr !< The array for the field to be read + !! in arbitrary rescaled units [A ~> a] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct integer, optional, intent(in) :: position !< A coded integer indicating the horizontal @@ -1067,6 +1091,8 @@ subroutine only_read_restart_field_4d(varname, f_ptr, G, CS, position, filename, character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully real, optional, intent(in) :: scale !< A factor by which the field will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path ! The full path to the file with the variable @@ -1087,6 +1113,7 @@ end subroutine only_read_restart_field_4d subroutine only_read_restart_field_3d(varname, f_ptr, G, CS, position, filename, directory, success, scale) character(len=*), intent(in) :: varname !< The variable name to be used in the restart file real, dimension(:,:,:), intent(inout) :: f_ptr !< The array for the field to be read + !! in arbitrary rescaled units [A ~> a] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct integer, optional, intent(in) :: position !< A coded integer indicating the horizontal @@ -1096,6 +1123,8 @@ subroutine only_read_restart_field_3d(varname, f_ptr, G, CS, position, filename, character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully real, optional, intent(in) :: scale !< A factor by which the field will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path ! The full path to the file with the variable @@ -1116,6 +1145,7 @@ end subroutine only_read_restart_field_3d subroutine only_read_restart_field_2d(varname, f_ptr, G, CS, position, filename, directory, success, scale) character(len=*), intent(in) :: varname !< The variable name to be used in the restart file real, dimension(:,:), intent(inout) :: f_ptr !< The array for the field to be read + !! in arbitrary rescaled units [A ~> a] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct integer, optional, intent(in) :: position !< A coded integer indicating the horizontal @@ -1125,6 +1155,8 @@ subroutine only_read_restart_field_2d(varname, f_ptr, G, CS, position, filename, character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully real, optional, intent(in) :: scale !< A factor by which the field will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path ! The full path to the file with the variable @@ -1146,7 +1178,9 @@ end subroutine only_read_restart_field_2d subroutine only_read_restart_pair_3d(a_ptr, b_ptr, a_name, b_name, G, CS, & stagger, filename, directory, success, scale) real, dimension(:,:,:), intent(inout) :: a_ptr !< The array for the first field to be read + !! in arbitrary rescaled units [A ~> a] real, dimension(:,:,:), intent(inout) :: b_ptr !< The array for the second field to be read + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: a_name !< The first variable name to be used in the restart file character(len=*), intent(in) :: b_name !< The second variable name to be used in the restart file type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -1157,7 +1191,9 @@ subroutine only_read_restart_pair_3d(a_ptr, b_ptr, a_name, b_name, G, CS, & !! character 'r' to read automatically named files character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully - real, optional, intent(in) :: scale !< A factor by which the field will be scaled + real, optional, intent(in) :: scale !< A factor by which the fields will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path_a ! The full path to the file with the first variable @@ -1277,8 +1313,8 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ integer :: num_files ! The number of restart files that will be used. integer :: seconds, days, year, month, hour, minute character(len=8) :: hor_grid, z_grid, t_grid ! Variable grid info. - real :: conv ! Shorthand for the conversion factor - real :: restart_time + real :: conv ! Shorthand for the conversion factor [a A-1 ~> 1] + real :: restart_time ! The model time at whic the restart file is being written [days] character(len=32) :: filename_appendix = '' ! Appendix to filename for ensemble runs integer :: length ! The length of a text string. integer(kind=8) :: check_val(CS%max_fields,1) @@ -1456,8 +1492,9 @@ subroutine restore_state(filename, directory, day, G, CS) type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct ! Local variables - real :: scale ! A scaling factor for reading a field - real :: conv ! The output conversion factor for writing a field + real :: scale ! A scaling factor for reading a field [A a-1 ~> 1] to convert + ! from the units in the file to the internal units of this field + real :: conv ! The output conversion factor for writing a field [a A-1 ~> 1] character(len=512) :: mesg ! A message for warnings. character(len=80) :: varname ! A variable's name. integer :: num_file ! The number of files (restart files and others @@ -1471,8 +1508,8 @@ subroutine restore_state(filename, directory, day, G, CS) logical :: unit_is_global(CS%max_fields) ! True if the file is global. character(len=8) :: hor_grid ! Variable grid info. - real :: t1, t2 ! Two times. - real, allocatable :: time_vals(:) + real :: t1, t2 ! Two times from the start of different files [days]. + real, allocatable :: time_vals(:) ! Times from a file extracted with getl_file_times [days] type(MOM_field), allocatable :: fields(:) logical :: is_there_a_checksum ! Is there a valid checksum that should be checked. integer(kind=8) :: checksum_file ! The checksum value recorded in the input file. From 6c34e7fbfefc0f4afd84f2abe25030563dbfe608 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 09:14:12 -0500 Subject: [PATCH 153/213] Document units of arguments in MOM_array_transform Added schematic unit descriptions to the comments describing the arguments to the MOM_array_transform routines, and clearly indicating that they work with variables with arbitrary units. Only comments are changed, and all answers are bitwise identical. --- src/framework/MOM_array_transform.F90 | 64 +++++++++++++-------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src/framework/MOM_array_transform.F90 b/src/framework/MOM_array_transform.F90 index d524f618a3..66c9925f11 100644 --- a/src/framework/MOM_array_transform.F90 +++ b/src/framework/MOM_array_transform.F90 @@ -71,9 +71,9 @@ module MOM_array_transform !> Rotate the elements of a 2d real array along first and second axes. subroutine rotate_array_real_2d(A_in, turns, A) - real, intent(in) :: A_in(:,:) !< Unrotated array + real, intent(in) :: A_in(:,:) !< Unrotated array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:) !< Rotated array + real, intent(out) :: A(:,:) !< Rotated array [arbitrary] integer :: m, n @@ -96,9 +96,9 @@ end subroutine rotate_array_real_2d !> Rotate the elements of a 3d real array along first and second axes. subroutine rotate_array_real_3d(A_in, turns, A) - real, intent(in) :: A_in(:,:,:) !< Unrotated array + real, intent(in) :: A_in(:,:,:) !< Unrotated array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:) !< Rotated array + real, intent(out) :: A(:,:,:) !< Rotated array [arbitrary] integer :: k @@ -110,9 +110,9 @@ end subroutine rotate_array_real_3d !> Rotate the elements of a 4d real array along first and second axes. subroutine rotate_array_real_4d(A_in, turns, A) - real, intent(in) :: A_in(:,:,:,:) !< Unrotated array + real, intent(in) :: A_in(:,:,:,:) !< Unrotated array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:,:) !< Rotated array + real, intent(out) :: A(:,:,:,:) !< Rotated array [arbitrary] integer :: n @@ -174,11 +174,11 @@ end subroutine rotate_array_logical !> Rotate the elements of a 2d real array pair along first and second axes. subroutine rotate_array_pair_real_2d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:) !< Unrotated scalar array pair - real, intent(in) :: B_in(:,:) !< Unrotated scalar array pair + real, intent(in) :: A_in(:,:) !< Unrotated scalar array pair [arbitrary] + real, intent(in) :: B_in(:,:) !< Unrotated scalar array pair [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:) !< Rotated scalar array pair - real, intent(out) :: B(:,:) !< Rotated scalar array pair + real, intent(out) :: A(:,:) !< Rotated scalar array pair [arbitrary] + real, intent(out) :: B(:,:) !< Rotated scalar array pair [arbitrary] if (modulo(turns, 2) /= 0) then call rotate_array(B_in, turns, A) @@ -192,11 +192,11 @@ end subroutine rotate_array_pair_real_2d !> Rotate the elements of a 3d real array pair along first and second axes. subroutine rotate_array_pair_real_3d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:,:) !< Unrotated scalar array pair - real, intent(in) :: B_in(:,:,:) !< Unrotated scalar array pair + real, intent(in) :: A_in(:,:,:) !< Unrotated scalar array pair [arbitrary] + real, intent(in) :: B_in(:,:,:) !< Unrotated scalar array pair [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:) !< Rotated scalar array pair - real, intent(out) :: B(:,:,:) !< Rotated scalar array pair + real, intent(out) :: A(:,:,:) !< Rotated scalar array pair [arbitrary] + real, intent(out) :: B(:,:,:) !< Rotated scalar array pair [arbitrary] integer :: k @@ -227,11 +227,11 @@ end subroutine rotate_array_pair_integer !> Rotate the elements of a 2d real vector along first and second axes. subroutine rotate_vector_real_2d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:) !< First component of unrotated vector - real, intent(in) :: B_in(:,:) !< Second component of unrotated vector + real, intent(in) :: A_in(:,:) !< First component of unrotated vector [arbitrary] + real, intent(in) :: B_in(:,:) !< Second component of unrotated vector [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:) !< First component of rotated vector - real, intent(out) :: B(:,:) !< Second component of unrotated vector + real, intent(out) :: A(:,:) !< First component of rotated vector [arbitrary] + real, intent(out) :: B(:,:) !< Second component of unrotated vector [arbitrary] call rotate_array_pair(A_in, B_in, turns, A, B) @@ -245,11 +245,11 @@ end subroutine rotate_vector_real_2d !> Rotate the elements of a 3d real vector along first and second axes. subroutine rotate_vector_real_3d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:,:) !< First component of unrotated vector - real, intent(in) :: B_in(:,:,:) !< Second component of unrotated vector + real, intent(in) :: A_in(:,:,:) !< First component of unrotated vector [arbitrary] + real, intent(in) :: B_in(:,:,:) !< Second component of unrotated vector [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:) !< First component of rotated vector - real, intent(out) :: B(:,:,:) !< Second component of unrotated vector + real, intent(out) :: A(:,:,:) !< First component of rotated vector [arbitrary] + real, intent(out) :: B(:,:,:) !< Second component of unrotated vector [arbitrary] integer :: k @@ -261,11 +261,11 @@ end subroutine rotate_vector_real_3d !> Rotate the elements of a 4d real vector along first and second axes. subroutine rotate_vector_real_4d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:,:,:) !< First component of unrotated vector - real, intent(in) :: B_in(:,:,:,:) !< Second component of unrotated vector + real, intent(in) :: A_in(:,:,:,:) !< First component of unrotated vector [arbitrary] + real, intent(in) :: B_in(:,:,:,:) !< Second component of unrotated vector [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:,:) !< First component of rotated vector - real, intent(out) :: B(:,:,:,:) !< Second component of unrotated vector + real, intent(out) :: A(:,:,:,:) !< First component of rotated vector [arbitrary] + real, intent(out) :: B(:,:,:,:) !< Second component of unrotated vector [arbitrary] integer :: n @@ -280,9 +280,9 @@ end subroutine rotate_vector_real_4d subroutine allocate_rotated_array_real_2d(A_in, lb, turns, A) ! NOTE: lb must be declared before A_in integer, intent(in) :: lb(2) !< Lower index bounds of A_in - real, intent(in) :: A_in(lb(1):, lb(2):) !< Reference array + real, intent(in) :: A_in(lb(1):, lb(2):) !< Reference array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, allocatable, intent(inout) :: A(:,:) !< Array on rotated index + real, allocatable, intent(inout) :: A(:,:) !< Array on rotated index [arbitrary] integer :: ub(2) @@ -300,9 +300,9 @@ end subroutine allocate_rotated_array_real_2d subroutine allocate_rotated_array_real_3d(A_in, lb, turns, A) ! NOTE: lb must be declared before A_in integer, intent(in) :: lb(3) !< Lower index bounds of A_in - real, intent(in) :: A_in(lb(1):, lb(2):, lb(3):) !< Reference array + real, intent(in) :: A_in(lb(1):, lb(2):, lb(3):) !< Reference array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, allocatable, intent(inout) :: A(:,:,:) !< Array on rotated index + real, allocatable, intent(inout) :: A(:,:,:) !< Array on rotated index [arbitrary] integer :: ub(3) @@ -320,9 +320,9 @@ end subroutine allocate_rotated_array_real_3d subroutine allocate_rotated_array_real_4d(A_in, lb, turns, A) ! NOTE: lb must be declared before A_in integer, intent(in) :: lb(4) !< Lower index bounds of A_in - real, intent(in) :: A_in(lb(1):,lb(2):,lb(3):,lb(4):) !< Reference array + real, intent(in) :: A_in(lb(1):,lb(2):,lb(3):,lb(4):) !< Reference array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, allocatable, intent(inout) :: A(:,:,:,:) !< Array on rotated index + real, allocatable, intent(inout) :: A(:,:,:,:) !< Array on rotated index [arbitrary] integer:: ub(4) From 94f97a56975b8234a00609c30c5e0f2bbec24bef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 09:14:41 -0500 Subject: [PATCH 154/213] Revise argument units in MOM_horizontal_regridding Revised the schematic unit descriptions to the comments describing the arguments to the MOM_horizontal_regridding routines, to clearly indicate when they work with rescaled variables. Only comments are changed, and all answers are bitwise identical. --- src/framework/MOM_horizontal_regridding.F90 | 106 ++++++++++++-------- 1 file changed, 62 insertions(+), 44 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index c2fe772571..83e7718311 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -33,22 +33,30 @@ module MOM_horizontal_regridding module procedure horiz_interp_and_extrap_tracer_fms_id end interface +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + contains !> Write to the terminal some basic statistics about the k-th level of an array subroutine myStats(array, missing, is, ie, js, je, k, mesg, scale) - real, dimension(:,:), intent(in) :: array !< input array [A] - real, intent(in) :: missing !< missing value [A] + real, dimension(:,:), intent(in) :: array !< input array in arbitrary units [A ~> a] + real, intent(in) :: missing !< missing value in arbitrary units [A ~> a] integer, intent(in) :: is !< Start index in i integer, intent(in) :: ie !< End index in i integer, intent(in) :: js !< Start index in j integer, intent(in) :: je !< End index in j integer, intent(in) :: k !< Level to calculate statistics for character(len=*), intent(in) :: mesg !< Label to use in message - real, optional, intent(in) :: scale !< A scaling factor for output. + real, optional, intent(in) :: scale !< A scaling factor for output [a A-1 ~> 1] ! Local variables - real :: minA, maxA ! Minimum and maximum vvalues in the array [A] - real :: scl ! A factor for undoing any scaling of the array statistics for output. + real :: minA ! Minimum value in the array in the arbitrary units of the input array [A ~> a] + real :: maxA ! Maximum value in the array in the arbitrary units of the input array [A ~> a] + real :: scl ! A factor for undoing any scaling of the array statistics for output [a A-1 ~> 1] integer :: i,j logical :: found character(len=120) :: lMesg @@ -85,7 +93,7 @@ end subroutine myStats subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, answer_date) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: aout !< The array with missing values to fill [A] + intent(inout) :: aout !< The array with missing values to fill [arbitrary] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: good !< Valid data mask for incoming array !! (1==good data; 0==missing data) [nondim]. @@ -93,9 +101,9 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, intent(in) :: fill !< Same shape array of points which need !! filling (1==fill;0==dont fill) [nondim] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: prev !< First guess where isolated holes exist [A] + intent(in) :: prev !< First guess where isolated holes exist [arbitrary] real, intent(in) :: acrit !< A minimal value for deltas between iterations that - !! determines when the smoothing has converged [A]. + !! determines when the smoothing has converged [arbitrary]. integer, optional, intent(in) :: num_pass !< The maximum number of iterations real, optional, intent(in) :: relc !< A relaxation coefficient for Laplacian [nondim] logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. @@ -104,13 +112,13 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. - real, dimension(SZI_(G),SZJ_(G)) :: a_filled ! The aout with missing values filled in [A] - real, dimension(SZI_(G),SZJ_(G)) :: a_chg ! The change in aout due to an iteration of smoothing [A] + real, dimension(SZI_(G),SZJ_(G)) :: a_filled ! The aout with missing values filled in [arbitrary] + real, dimension(SZI_(G),SZJ_(G)) :: a_chg ! The change in aout due to an iteration of smoothing [arbitrary] real, dimension(SZI_(G),SZJ_(G)) :: fill_pts ! 1 for points that still need to be filled [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good_ ! The values that are valid for the current iteration [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good_new ! The values of good_ to use for the next iteration [nondim] - real :: east, west, north, south ! Valid neighboring values or 0 for invalid values [A] + real :: east, west, north, south ! Valid neighboring values or 0 for invalid values [arbitrary] real :: ge, gw, gn, gs ! Flags indicating which neighbors have valid values [nondim] real :: ngood ! The number of valid values in neighboring points [nondim] real :: nfill ! The remaining number of points to fill [nondim] @@ -262,7 +270,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z !< Allocatable tracer array on the horizontal - !! model grid and input-file vertical levels. [CU ~> conc] + !! model grid and input-file vertical levels + !! in arbitrary units [A ~> a] real, allocatable, dimension(:,:,:), intent(out) :: mask_z !< Allocatable tracer mask array on the horizontal !! model grid and input-file vertical levels [nondim] @@ -272,9 +281,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr !< Cell grid edge values for input data [Z ~> m] real, intent(out) :: missing_value !< The missing value in the returned array, scaled !! to avoid accidentally having valid values match - !! missing values [CU ~> conc] + !! missing values in the same units as tr_z [A ~> a] real, intent(in) :: scale !< Scaling factor for tracer into the internal - !! units of the model [CU conc-1 ~> 1] + !! units of the model for the units in the file [A a-1 ~> 1] logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions real, optional, intent(in) :: m_to_Z !< A conversion factor from meters to the units @@ -287,19 +296,21 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr !! extrapolation is performed by this routine real, optional, intent(in) :: tr_iter_tol !< The tolerance for changes in tracer concentrations !! between smoothing iterations that determines when to - !! stop iterating [CU ~> conc] + !! stop iterating in the same units as tr_z [A ~> a] integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. !! Dates before 20190101 give the same answers !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its !! native horizontal grid, with units that change - !! as the input data is interpreted [conc] then [CU ~> conc] + !! as the input data is interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: tr_inp !< Native horizontal grid data extended to the poles !! with units that change as the input data is - !! interpreted [conc] then [CU ~> conc] + !! interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: mask_in ! A 2-d mask for extended input grid [nondim] real :: PI_180 ! A conversion factor from degrees to radians @@ -312,10 +323,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr real, dimension(:), allocatable :: lat_in ! The latitudes in the input file [degreesN] then [radians] real, dimension(:), allocatable :: lat_inp ! The input file latitudes expanded to the pole [degreesN] then [radians] real :: max_lat ! The maximum latitude on the input grid [degreesN] - real :: pole ! The sum of tracer values at the pole [conc] + real :: pole ! The sum of tracer values at the pole [a] real :: max_depth ! The maximum depth of the ocean [Z ~> m] real :: npole ! The number of points contributing to the pole value [nondim] - real :: missing_val_in ! The missing value in the input field [conc] + real :: missing_val_in ! The missing value in the input field [a] real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] real :: add_offset, scale_factor ! File-specific conversion factors. integer :: ans_date ! The vintage of the expressions and order of arithmetic to use @@ -329,17 +340,17 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr integer :: isd, ied, jsd, jed ! data domain indices integer :: id_clock_read logical :: debug=.false. - real :: I_scale ! The inverse of the scale factor for diagnostic output [conc CU-1 ~> 1] + real :: I_scale ! The inverse of the scale factor for diagnostic output [a A-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing - ! iterations that determines when to stop iterating [CU ~> conc] + ! iterations that determines when to stop iterating [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: lon_out ! The longitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: lat_out ! The latitude of points on the model grid [radians] - real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: mask_out ! The mask on the model grid [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good ! Where the data is valid, this is 1 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill ! 1 where the data needs to be filled in [nondim] - real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [CU ~> conc] - real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [A ~> a] + real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: good2 ! 1 where the data is valid after Ice-9 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill2 ! 1 for points that still need to be filled after Ice-9 [nondim] @@ -597,7 +608,8 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z !< Allocatable tracer array on the horizontal - !! model grid and input-file vertical levels [CU ~> conc] + !! model grid and input-file vertical levels + !! in arbitrary units [A ~> a] real, allocatable, dimension(:,:,:), intent(out) :: mask_z !< Allocatable tracer mask array on the horizontal !! model grid and input-file vertical levels [nondim] @@ -607,9 +619,9 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, !< Cell grid edge values for input data [Z ~> m] real, intent(out) :: missing_value !< The missing value in the returned array, scaled !! to avoid accidentally having valid values match - !! missing values [CU ~> conc] + !! missing values, in the same arbitrary units as tr_z [A ~> a] real, intent(in) :: scale !< Scaling factor for tracer into the internal - !! units of the model [CU conc-1 ~> 1] + !! units of the model [A a-1 ~> 1] logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions logical, optional, intent(in) :: spongeOngrid !< If present and true, the sponge data are on the model grid @@ -620,21 +632,23 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, !! add parentheses for rotational symmetry. real, optional, intent(in) :: tr_iter_tol !< The tolerance for changes in tracer concentrations !! between smoothing iterations that determines when to - !! stop iterating [CU ~> conc] + !! stop iterating, in the same arbitrary units as tr_z [A ~> a] integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. !! Dates before 20190101 give the same answers !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its !! native horizontal grid, with units that change - !! as the input data is interpreted [conc] then [CU ~> conc] + !! as the input data is interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: tr_inp !< Native horizontal grid data extended to the poles !! with units that change as the input data is - !! interpreted [conc] then [CU ~> conc] + !! interpreted [a] then [A ~> a] real, dimension(:,:,:), allocatable :: data_in !< A buffer for storing the full 3-d time-interpolated array - !! on the original grid [conc] + !! on the original grid [a] real, dimension(:,:), allocatable :: mask_in !< A 2-d mask for extended input grid [nondim] real :: PI_180 ! A conversion factor from degrees to radians @@ -646,10 +660,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, real, dimension(:), allocatable :: lat_in ! The latitudes in the input file [degreesN] then [radians] real, dimension(:), allocatable :: lat_inp ! The input file latitudes expanded to the pole [degreesN] then [radians] real :: max_lat ! The maximum latitude on the input grid [degreesN] - real :: pole ! The sum of tracer values at the pole [conc] + real :: pole ! The sum of tracer values at the pole [a] real :: max_depth ! The maximum depth of the ocean [Z ~> m] real :: npole ! The number of points contributing to the pole value [nondim] - real :: missing_val_in ! The missing value in the input field [conc] + real :: missing_val_in ! The missing value in the input field [a] real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] logical :: add_np type(horiz_interp_type) :: Interp @@ -662,17 +676,17 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, logical :: debug=.false. logical :: is_ongrid integer :: ans_date ! The vintage of the expressions and order of arithmetic to use - real :: I_scale ! The inverse of the scale factor for diagnostic output [conc CU-1 ~> 1] + real :: I_scale ! The inverse of the scale factor for diagnostic output [a A-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing - ! iterations that determines when to stop iterating [CU ~> conc] + ! iterations that determines when to stop iterating [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: lon_out ! The longitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: lat_out ! The latitude of points on the model grid [radians] - real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: mask_out ! The mask on the model grid [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good ! Where the data is valid, this is 1 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill ! 1 where the data needs to be filled in [nondim] - real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [CU ~> conc] - real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [A ~> a] + real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: good2 ! 1 where the data is valid after Ice-9 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill2 ! 1 for points that still need to be filled after Ice-9 [nondim] integer :: turns @@ -900,8 +914,9 @@ end subroutine horiz_interp_and_extrap_tracer_fms_id !> Replace all values of a 2-d field with the weighted average over the valid points. subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale) type(ocean_grid_type), intent(inout) :: G !< Ocean grid type - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: field !< The tracer on the model grid [A ~> a] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: weight !< The weights for the tracer [B ~> b] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: field !< The tracer on the model grid in arbitrary units [A ~> a] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: weight !< The weights for the tracer in arbitrary units that + !! typically differ from those used by field [B ~> b] real, intent(in) :: scale !< A rescaling factor that has been used for the !! variable and has to be undone before the !! reproducing sums [A a-1 ~> 1] @@ -915,6 +930,9 @@ subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale) !! reproducing sums [b B-1 ~> 1] ! Local variables + ! In the following comments, [A] and [B] are used to indicate the arbitrary, possibly rescaled + ! units of the input field and the weighting array, while [a] and [b] indicate the corresponding + ! unscaled (e.g., mks) units that can be used with the reproducing sums real, dimension(SZI_(G),SZJ_(G)) :: field_for_Sums ! The field times the weights with the scaling undone [a b] real, dimension(SZI_(G),SZJ_(G)) :: wts_for_Sums ! A copy of the wieghts with the scaling undone [b] real :: var_unscale ! The reciprocal of the scaling factor for the field and weights [a b A-1 B-1 ~> 1] @@ -974,10 +992,10 @@ end subroutine homogenize_field !> Create a 2d-mesh of grid coordinates from 1-d arrays. subroutine meshgrid(x, y, x_T, y_T) - real, dimension(:), intent(in) :: x !< input 1-dimensional vector - real, dimension(:), intent(in) :: y !< input 1-dimensional vector - real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array - real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array + real, dimension(:), intent(in) :: x !< input 1-dimensional vector [arbitrary] + real, dimension(:), intent(in) :: y !< input 1-dimensional vector [arbitrary] + real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array [arbitrary] + real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array [arbitrary] integer :: ni, nj, i, j From a3b61c818ea7b14ae7fd962caa2cd103c6075173 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 31 Jan 2023 09:15:04 -0500 Subject: [PATCH 155/213] Document units of invcosh and its argument Document the (nondimensional) units of both real variables in MOM_intrinsic functions. Only comments are changed, and all answers are bitwise identical. --- src/framework/MOM_intrinsic_functions.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_intrinsic_functions.F90 b/src/framework/MOM_intrinsic_functions.F90 index fdda8849ae..2439c628fc 100644 --- a/src/framework/MOM_intrinsic_functions.F90 +++ b/src/framework/MOM_intrinsic_functions.F90 @@ -13,9 +13,9 @@ module MOM_intrinsic_functions !> Evaluate the inverse cosh, either using a math library or an !! equivalent expression function invcosh(x) - real, intent(in) :: x !< The argument of the inverse of cosh. NaNs will + real, intent(in) :: x !< The argument of the inverse of cosh [nondim]. NaNs will !! occur if x<1, but there is no error checking - real :: invcosh + real :: invcosh ! The inverse of cosh of x [nondim] #ifdef __INTEL_COMPILER invcosh = acosh(x) From 19f683db274f8a70997f75bf744ff757f0cae3bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 Jan 2023 17:39:59 -0500 Subject: [PATCH 156/213] Document units of variables in MOM_energetic_PBL Added or amended comments to document the units of numerous internal variables in MOM_energetic_PBL.F90, and corrected a few spelling errors in comments. Only comments are changed, and all answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 107 ++++++++++-------- 1 file changed, 60 insertions(+), 47 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index bd0740ccbd..01885a0484 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -59,7 +59,7 @@ module MOM_energetic_PBL !! returned value from the previous guess or bisection before this. integer :: max_MLD_its !< The maximum number of iterations that can be used to find a !! self-consistent mixed layer depth with Use_MLD_iteration. - real :: MixLenExponent !< Exponent in the mixing length shape-function. + real :: MixLenExponent !< Exponent in the mixing length shape-function [nondim]. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by @@ -68,11 +68,11 @@ module MOM_energetic_PBL real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the - !! diffusive length scale by rotation. Making this larger decreases + !! diffusive length scale by rotation [nondim]. Making this larger decreases !! the diffusivity in the planetary boundary layer. real :: transLay_scale !< A scale for the mixing length in the transition layer !! at the edge of the boundary layer as a fraction of the - !! boundary layer thickness. The default is 0, but a + !! boundary layer thickness [nondim]. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when !! Use_MLD_iteration is true [H ~> m or kg m-2]. @@ -98,7 +98,7 @@ module MOM_energetic_PBL integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing, - !! there must be a cap on how large it can be. This + !! there must be a cap on how large it can be [nondim]. This !! is definitely a function of latitude (Ekman limit), !! but will be taken as constant for now. @@ -113,45 +113,45 @@ module MOM_energetic_PBL !! for using a fixed mstar is used. !/ mstar_scheme == 2 - real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 - real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 [nondim] + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 [nondim] !/ mstar_scheme == 3 - real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outer-most coefficient for fit). + real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outer-most coefficient for fit) [nondim]. !! Value of 0.275 in RH18. Increasing this !! coefficient increases mechanical mixing for all values of Hf/ust, !! but is most effective at low values (weakly developed OSBLs). - real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). + real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay) [nondim]. !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR !! for all values of HF/ust, with a consistent affect across !! a wide range of Hf/ust. - real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of + real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient) [nondim]. Value of !! -5.0 in RH18. Increasing this increases how quickly the value !! of MSTAR decreases as Hf/ust increases. - real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. + real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit [nondim]. !! Value of 0.2 in RH18. - real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. + real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit [nondim]. !! Value of 0.4 in RH18. !/ Coefficient for shear/convective turbulence interaction - real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable. + real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable [nondim]. !/ Langmuir turbulence related parameters logical :: Use_LT = .false. !< Flag for using LT in Energy calculation integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) - real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancement - real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement + real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancement [nondim] + real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement [nondim] real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of - !! the mixed layer depth over the Ekman depth. + !! the mixed layer depth over the Ekman depth [nondim]. real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of - !! the mixed layer depth over the Obukhov depth with stabilizing forcing. + !! the mixed layer depth over the Obukhov depth with stabilizing forcing [nondim]. real :: LaC_EKoOB_stab !< Coefficient for Langmuir number modification based on the ratio of - !! the Ekman depth over the Obukhov depth with stabilizing forcing. + !! the Ekman depth over the Obukhov depth with stabilizing forcing [nondim]. real :: LaC_MLDoOB_un !< Coefficient for Langmuir number modification based on the ratio of - !! the mixed layer depth over the Obukhov depth with destabilizing forcing. + !! the mixed layer depth over the Obukhov depth with destabilizing forcing [nondim]. real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of - !! the Ekman depth over the Obukhov depth with destabilizing forcing. - real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing. + !! the Ekman depth over the Obukhov depth with destabilizing forcing [nondim]. + real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing [nondim]. !/ Others type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. @@ -229,8 +229,8 @@ module MOM_energetic_PBL !> A type for conveniently passing around ePBL diagnostics for a column. type, public :: ePBL_column_diags ; private !>@{ Local column copies of energy change diagnostics, all in [R Z3 T-3 ~> W m-2]. - real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing - real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay + real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing ! Local column diagnostics [R Z3 T-3 ~> W m-2] + real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay ! Local column diagnostics [R Z3 T-3 ~> W m-2] !>@} real :: LA !< The value of the Langmuir number [nondim] real :: LAmod !< The modified Langmuir number by convection [nondim] @@ -570,8 +570,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! during this timestep [R Z3 T-2 ~> J m-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. - real :: uhtot ! The depth integrated zonal and meridional velocities in the - real :: vhtot ! layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + real :: uhtot ! The depth integrated zonal velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1] + real :: vhtot ! The depth integrated meridional velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1] real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. @@ -612,7 +612,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate asymptotic value at the bottom of - ! the boundary layer. + ! the boundary layer [nondim]. Kddt_h ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. @@ -642,9 +642,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2]. real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. - real :: C1_3 ! = 1/3. + real :: C1_3 ! = 1/3 [nondim] real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1]. - ! This is used convert TKE back into ustar^3. + ! This is used convert TKE back into ustar^3 for use in a cube root. real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) @@ -708,8 +708,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! - needed to compute new mixing length. real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [H ~> m or kg m-2]. real :: MLD_guess_Z ! A guessed mixed layer depth, converted to height units [Z ~> m] - real :: min_MLD ! Iteration bounds [H ~> m or kg m-2], which are adjusted at each step - real :: max_MLD ! - These are initialized based on surface/bottom + real :: min_MLD, max_MLD ! Iteration bounds on MLD [H ~> m or kg m-2], which are adjusted at each step + ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from prev step or neighbor). ! 2. The iteration checks if value is converged, too shallow, or too deep. ! 3. Based on result adjusts the Max/Min and searches through the water column. @@ -726,14 +726,24 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs logical :: OBL_converged ! Flag for convergence of MLD integer :: OBL_it ! Iteration counter - real :: Surface_Scale ! Surface decay scale for vstar + real :: Surface_Scale ! Surface decay scale for vstar [nondim] logical :: calc_Te ! If true calculate the expected final temperature and salinity values. logical :: debug ! This is used as a hard-coded value for debugging. ! The following arrays are used only for debugging purposes. - real :: dPE_debug, mixing_debug - real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt - real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k + real :: dPE_debug ! An estimate of the potential energy change [R Z3 T-2 ~> J m-2] + real :: mixing_debug ! An estimate of the rate of change of potential energy due to mixing [R Z3 T-3 ~> W m-2] + real, dimension(20) :: TKE_left_itt ! The value of TKE_left after each iteration [R Z3 T-2 ~> J m-2] + real, dimension(20) :: PE_chg_itt ! The value of PE_chg after each iteration [R Z3 T-2 ~> J m-2] + real, dimension(20) :: Kddt_h_itt ! The value of Kddt_h_guess after each iteration [H ~> m or kg m-2] + real, dimension(20) :: dPEa_dKd_itt ! The value of dPEc_dKd after each iteration [R Z3 T-2 H-1 ~> J m-3 or J kg-1] + real, dimension(20) :: MKE_src_itt ! The value of MKE_src after each iteration [R Z3 T-2 ~> J m-2] + real, dimension(SZK_(GV)) :: mech_TKE_k ! The mechanically generated turbulent kinetic energy + ! available for mixing over a time step for each layer [R Z3 T-2 ~> J m-2]. + real, dimension(SZK_(GV)) :: conv_PErel_k ! The potential energy that has been convectively released + ! during this timestep for each layer [R Z3 T-2 ~> J m-2]. + real, dimension(SZK_(GV)) :: nstar_k ! The fraction of conv_PErel that can be converted to mixing + ! for each layer [nondim]. real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [C ~> degC] real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [S ~> ppt] integer, dimension(SZK_(GV)) :: num_itts @@ -1185,7 +1195,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs Kddt_h(K) = Kd(K) * dt_h elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then - ! This column is convctively stable and there is energy to support the suggested + ! This column is convectively stable and there is energy to support the suggested ! mixing. Keep that estimate. Kd(K) = Kd_guess0 Kddt_h(K) = Kddt_h_g0 @@ -1398,7 +1408,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs MLD_guess = 0.5*(min_MLD + max_MLD) else ! Try using the false position method or the returned value instead of simple bisection. ! Taking the occasional step with MLD_output empirically helps to converge faster. - if ((dMLD_min > 0.0) .and. (dMLD_max < 0.0) .and. (OBL_it > 2) .and. (mod(OBL_it-1,4)>0)) then + if ((dMLD_min > 0.0) .and. (dMLD_max < 0.0) .and. (OBL_it > 2) .and. (mod(OBL_it-1,4) > 0)) then ! Both bounds have valid change estimates and are probably in the range of possible outputs. MLD_Guess = (dMLD_min*max_MLD - dMLD_max*min_MLD) / (dMLD_min - dMLD_max) elseif ((MLD_found > min_MLD) .and. (MLD_found < max_MLD)) then @@ -1809,7 +1819,6 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& MStar = MStar * MStar_Conv_Red if (present(Langmuir_Number)) then - !### In this call, ustar was previously ustar_mean. Is this change deliberate, Brandon? -RWH call mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, MStar, & MStar_LT, Convect_Langmuir_Number) endif @@ -1831,9 +1840,9 @@ subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langm real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ - real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. - real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence. - real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence. + real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio [nondim]. + real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence [nondim]. + real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence [nondim]. real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1] @@ -1841,10 +1850,14 @@ subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langm real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim]. - real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim]. - real :: Ekman_Obukhov_stab ! > - real :: MLD_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_Obukhov_un ! > + real :: MLD_Obukhov_stab ! The mixed layer depth divided by the Obukhov depth under stable + ! conditions or 0 under unstable conditions [nondim]. + real :: Ekman_Obukhov_stab ! The Ekman layer thickness divided by the Obukhov depth under stable + ! conditions or 0 under unstable conditions [nondim]. + real :: MLD_Obukhov_un ! The mixed layer depth divided by the Obukhov depth under unstable + ! conditions or 0 under stable conditions [nondim]. + real :: Ekman_Obukhov_un ! The Ekman layer thickness divided by the Obukhov depth under unstable + ! conditions or 0 under stable conditions [nondim]. ! Set default values for no Langmuir effects. enhance_mstar = 1.0 ; mstar_LT_add = 0.0 @@ -1910,9 +1923,9 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m] or other units real, optional, intent(in) :: m_to_MLD_units !< A conversion factor from meters - !! to the desired units for MLD + !! to the desired units for MLD, sometimes [m Z-1 ~> 1] ! Local variables - real :: scale ! A dimensional rescaling factor + real :: scale ! A dimensional rescaling factor, often [nondim] or [m Z-1 ~> 1] integer :: i,j scale = 1.0 ; if (present(m_to_MLD_units)) scale = US%Z_to_m * m_to_MLD_units @@ -1939,7 +1952,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) # include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. character(len=20) :: tmpstr - real :: omega_frac_dflt + real :: omega_frac_dflt ! The default for omega_frac [nondim] integer :: isd, ied, jsd, jed integer :: mstar_mode, LT_enhance, wT_mode integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. @@ -2390,7 +2403,7 @@ subroutine energetic_PBL_end(CS) type(energetic_PBL_CS), intent(inout) :: CS !< Energetic_PBL control structure character(len=256) :: mesg - real :: avg_its + real :: avg_its ! The averaged number of iterations used by ePBL [nondim] if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) if (allocated(CS%LA)) deallocate(CS%LA) From cd9ef0af2e086dfcf9ec3cd1d1566dabdabfc300 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 21 Jan 2023 13:08:31 -0500 Subject: [PATCH 157/213] Document units of variables in MOM_diapyc_energy_req Added or amended comments to document the units of numerous internal variables in MOM_diapyc_energy_req.F90, and corrected a few spelling errors in comments. Also eliminated an unused variable. All answers are bitwise identical. --- .../vertical/MOM_diapyc_energy_req.F90 | 89 ++++++++++++------- 1 file changed, 57 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 2ddf8b8c7a..bbc4c9bf96 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -68,9 +68,11 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) real, dimension(GV%ke+1) :: & Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. - real :: ustar, absf, htot + real :: ustar ! The local friction velocity [Z T-1 ~> m s-1] + real :: absf ! The absolute value of the Coriolis parameter [T-1 ~> s-1] + real :: htot ! The sum of the thicknesses [H ~> m or kg m-2]. real :: energy_Kd ! The energy used by diapycnal mixing [R Z L2 T-3 ~> W m-2]. - real :: tmp1 ! A temporary array. + real :: tmp1 ! A temporary array [H Z ~> m2 or kg m-1] integer :: i, j, k, is, ie, js, je, nz logical :: may_print is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -100,7 +102,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) ustar = 0.01*US%m_to_Z*US%T_to_s ! Change this to being an input parameter? absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) + (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z @@ -168,24 +170,38 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! mixing effects with other yet lower layers [C H ~> degC m or degC kg m-2]. Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [S H ~> ppt m or ppt kg m-2]. - dT_to_dPE, & ! Partial derivative of column potential energy with the temperature and salinity - dS_to_dPE, & ! changes within a layer [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1] - dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. - dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. - dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water column [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. - dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column, in - ! units of [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. - dT_to_dPE_b, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water column, in - ! units of [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. + dT_to_dPE, & ! Partial derivative of column potential energy with the temperature changes within + ! a layer [R Z L2 T-2 C-1 ~> J m-2 degC-1] + dS_to_dPE, & ! Partial derivative of column potential energy with the salinity changes within + ! a layer [R Z L2 T-2 S-1 ~> J m-2 ppt-1] + dT_to_dColHt, & ! Partial derivative of the total column height with the temperature + ! changes within a layer [Z C-1 ~> m degC-1] + dS_to_dColHt, & ! Partial derivative of the total column height with the + ! salinity changes within a layer [Z S-1 ~> m ppt-1]. + dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z C-1 ~> m degC-1]. + dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! of mixing with layers higher in the water column [Z S-1 ~> m ppt-1]. + dT_to_dColHt_b, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column [Z C-1 ~> m degC-1]. + dS_to_dColHt_b, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column [Z S-1 ~> m ppt-1]. + dT_to_dPE_a, & ! Partial derivative of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column, in units of [R Z L2 T-2 C-1 ~> J m-2 degC-1]. + dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column, in units of [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. + dT_to_dPE_b, & ! Partial derivative of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column, in units of [R Z L2 T-2 C-1 ~> J m-2 degC-1]. + dS_to_dPE_b, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column, in units of [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. hp_a, & ! An effective pivot thickness of the layer including the effects ! of coupling with layers above [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. @@ -243,16 +259,26 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! The following are a bunch of diagnostic arrays for debugging purposes. real, dimension(GV%ke) :: & - Ta, Sa, Tb, Sb + Ta, Tb, & ! Copies of temperature profiles for debugging [C ~> degC] + Sa, Sb ! Copies of salinity profiles for debugging [S ~> ppt] real, dimension(GV%ke+1) :: & - dPEa_dKd, dPEa_dKd_est, dPEa_dKd_err, dPEa_dKd_trunc, dPEa_dKd_err_norm, & - dPEb_dKd, dPEb_dKd_est, dPEb_dKd_err, dPEb_dKd_trunc, dPEb_dKd_err_norm - real :: PE_chg_tot1A, PE_chg_tot2A, T_chg_totA - real :: PE_chg_tot1B, PE_chg_tot2B, T_chg_totB - real :: PE_chg_tot1C, PE_chg_tot2C, T_chg_totC - real :: PE_chg_tot1D, PE_chg_tot2D, T_chg_totD - real, dimension(GV%ke+1) :: dPEchg_dKd - real :: PE_chg(6) + dPEa_dKd, dPEa_dKd_est, & ! Estimates of the partial derivative of the column potential energy + ! change with Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + dPEb_dKd, dPEb_dKd_est, & ! Estimates of the partial derivative of the column potential energy + ! change with Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + dPEa_dKd_err, dPEb_dKd_err, & ! Differences in estimates of the partial derivative of the column + ! potential energy change with Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + dPEa_dKd_err_norm, dPEb_dKd_err_norm, & ! Normalized changes in sensitivities [nondim] + dPEa_dKd_trunc, dPEb_dKd_trunc ! Estimates of the truncation error in estimates of the partial + ! derivative of the column potential energy change with + ! Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + real :: PE_chg_tot1A, PE_chg_tot2A ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: PE_chg_tot1B, PE_chg_tot2B ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: PE_chg_tot1C, PE_chg_tot2C ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: PE_chg_tot1D, PE_chg_tot2D ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: T_chg_totA, T_chg_totB ! Vertically integrated temperature changes [C H ~> degC m or degC kg m-2] + real :: T_chg_totC, T_chg_totD ! Vertically integrated temperature changes [C H ~> degC m or degC kg m-2] + real :: PE_chg(6) ! The potential energy change within the first few iterations [R Z L2 T-2 ~> J m-2] integer :: k, nz, itt, k_cent logical :: surface_BL, bottom_BL, central, halves, debug @@ -309,7 +335,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! PE_chg_k(1) = 0.0 ; PE_chg_k(nz+1) = 0.0 ! PEchg(:) = 0.0 PE_chg_k(:,:) = 0.0 ; ColHt_cor_k(:,:) = 0.0 - dPEchg_dKd(:) = 0.0 if (surface_BL) then ! This version is appropriate for a surface boundary layer. old_PE_calc = .false. @@ -1031,7 +1056,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, !! [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could - !! be realizedd by applying a huge value of Kddt_h at the + !! be realized by applying a huge value of Kddt_h at the !! present interface [R Z L2 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the !! limit where Kddt_h = 0 [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. From 7a9d151cfb17085eeb241d4964c2cf9d275c383c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:27:02 -0500 Subject: [PATCH 158/213] Document units of 16 variables in MOM_opacity Added or amended comments to document the units of 16 internal variables in MOM_opacity.F90, and corrected a spelling error in a comment. Only comments are changed, and all answers are bitwise identical. --- .../vertical/MOM_opacity.F90 | 27 ++++++++++--------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index ccedb5c607..43462131ca 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -68,7 +68,7 @@ module MOM_opacity !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - logical :: warning_issued !< A flag that is used to avoid repetative warnings. + logical :: warning_issued !< A flag that is used to avoid repetitive warnings. !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 @@ -402,7 +402,7 @@ end subroutine opacity_from_chl !> This sets the blue-wavelength opacity according to the scheme proposed by !! Morel and Antoine (1994). function opacity_morel(chl_data) - real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. + real, intent(in) :: chl_data !< The chlorophyll-A concentration in [mg m-3] real :: opacity_morel !< The returned opacity [m-1] ! The following are coefficients for the optical model taken from Morel and @@ -411,8 +411,8 @@ function opacity_morel(chl_data) ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. real, dimension(6), parameter :: & - Z2_coef = (/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) - real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2. + Z2_coef = (/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) ! Extinction length coefficients [m] + real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2 [nondim] Chl = log10(min(max(chl_data,0.02),60.0)) ; Chl2 = Chl*Chl opacity_morel = 1.0 / ( (Z2_coef(1) + Z2_coef(2)*Chl) + Chl2 * & @@ -430,9 +430,9 @@ function SW_pen_frac_morel(chl_data) ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. - real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2. + real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2 [nondim] real, dimension(6), parameter :: & - V1_coef = (/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) + V1_coef = (/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) ! Penetrating fraction coefficients [nondim] Chl = log10(min(max(chl_data,0.02),60.0)) ; Chl2 = Chl*Chl SW_pen_frac_morel = 1.0 - ( (V1_coef(1) + V1_coef(2)*Chl) + Chl2 * & @@ -442,7 +442,7 @@ end function SW_pen_frac_morel !> This sets the blue-wavelength opacity according to the scheme proposed by !! Manizza, M. et al, 2005. function opacity_manizza(chl_data) - real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. + real, intent(in) :: chl_data !< The chlorophyll-A concentration [mg m-3] real :: opacity_manizza !< The returned opacity [m-1] ! This sets the blue-wavelength opacity according to the scheme proposed by Manizza, M. et al, 2005. @@ -460,15 +460,16 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), & optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer [Z-1 ~> m-1], !! but with units that can be altered by opacity_scale. - real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. + real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity [nondim] or + !! [Z H-1 ~> 1 or m3 kg-1] real, dimension(max(optics%nbands,1),SZI_(G)), & optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2] !! at the surface in each of the nbands bands !! that penetrates beyond the surface skin layer. - real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. + real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux [nondim]? ! Local variables - real :: scale_opacity, scale_penSW ! Rescaling factors + real :: scale_opacity, scale_penSW ! Rescaling factors [nondim]? integer :: i, is, ie, k, nz, n is = G%isc ; ie = G%iec ; nz = GV%ke @@ -604,7 +605,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! is moved upward [C H ~> degC m or degC kg m-2] real :: SWa ! fraction of the absorbed shortwave that is ! moved to layers above with adjustAbsorptionProfile [nondim] - real :: coSWa_frac ! The fraction of SWa that is actually moved upward. + real :: coSWa_frac ! The fraction of SWa that is actually moved upward [nondim] real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply ! absorbed in the next layer for computational efficiency, instead of ! continuing to penetrate [C H ~> degC m or degC kg m-2]. @@ -617,7 +618,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! was not entirely absorbed. logical :: TKE_calc ! If true, calculate the implications to the ! TKE budget of the shortwave heating. - real :: C1_6, C1_60 + real :: C1_6, C1_60 ! Rational fractions [nondim] integer :: is, ie, nz, i, k, ks, n if (nsw < 1) return @@ -830,7 +831,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & real :: SW_trans ! fraction of shortwave radiation not ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation - ! not absorbed because the layers are too thin. + ! not absorbed because the layers are too thin [nondim]. real :: Ih_limit ! inverse of the total depth at which the ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply From 905493947368ce975cf03d48e969e663745260ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:27:52 -0500 Subject: [PATCH 159/213] Document units of 21 variables in MOM_bulk_mixed_layer Added or amended comments to document the units of 21 internal variables in MOM_bulk_mixed_layer.F90, and corrected a few spelling errors in comments. Only comments are changed, and all answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 49 ++++++++++--------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 9d118f9096..5e530bea3d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -253,7 +253,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C uhtot, & ! The depth integrated zonal velocity in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] vhtot, & ! The depth integrated meridional velocity in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] - netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if + netMassInOut, & ! The net mass flux (if non-Boussinesq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the ! ocean over a time step [H ~> m or kg m-2]. NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if Boussinesq) @@ -287,11 +287,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! denominator of MKE_rate; the two elements have differing ! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real :: Irho0 ! 1.0 / rho_0 [R-1 ~> m3 kg-1] - real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) + real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) [nondim] real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1]. - real :: RmixConst - + real :: RmixConst ! A combination of constants used in the river mixing energy + ! calculation [L2 T-2 R-2 ~> m8 s-2 kg-2] real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection ! [Z L2 T-2 ~> m3 s-2]. @@ -316,7 +316,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! layers before detrainment in to the interior [H ~> m or kg m-2]. max_BL_det ! If non-negative, the maximum amount of entrainment from ! the buffer layers that will be allowed this time step [H ~> m or kg m-2]. - real :: dHsfc, dHD ! Local copies of nondimensional parameters. + real :: dHsfc, dHD ! Local copies of nondimensional parameters [nondim] real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2]. real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. @@ -344,9 +344,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) - Irho0 = 1.0 / (GV%Rho0) + Irho0 = 1.0 / GV%Rho0 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - Idt_diag = 1.0 / (dt__diag) + Idt_diag = 1.0 / dt__diag write_diags = .true. ; if (present(last_call)) write_diags = last_call p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref @@ -795,8 +795,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! entrained [C H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained ! [H S ~> m ppt or ppt kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + uhtot, & ! The depth integrated zonal velocities in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] + vhtot, & ! The depth integrated meridional velocities in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] KE_orig, & ! The total mean kinetic energy per unit area in the mixed layer before ! convection, [H L2 T-2 ~> m3 s-2 or kg s-2]. h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. @@ -984,13 +984,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! entrainment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: T_precip ! The temperature of the precipitation [C ~> degC]. - real :: C1_3, C1_6 ! 1/3 and 1/6. - real :: En_fn, Frac, x1 ! Nondimensional temporary variables. + real :: C1_3, C1_6 ! 1/3 and 1/6 [nondim] + real :: En_fn, Frac, x1 ! Nondimensional temporary variables [nondim]. real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. real :: dr_ent, dr_comp ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. real :: dr_dh ! The partial derivative of dr_ent with h_ent [R ~> kg m-3]. - real :: h_min, h_max ! The minimum, maximum, and previous estimates for - real :: h_prev ! h_ent [H ~> m or kg m-2]. + real :: h_min, h_max ! The minimum and maximum estimates for h_ent [H ~> m or kg m-2] + real :: h_prev ! The previous estimate for h_ent [H ~> m or kg m-2] real :: h_evap ! The thickness that is evaporated [H ~> m or kg m-2]. real :: dh_Newt ! The Newton's method estimate of the change in ! h_ent between iterations [H ~> m or kg m-2]. @@ -1005,7 +1005,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: Idt ! 1.0/dt [T-1 ~> s-1] integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & - C2, & ! Temporary variable R H-1 ~> kg m-4 or m-1]. + C2, & ! Temporary variable [R H-1 ~> kg m-4 or m-1]. r_SW_top ! Temporary variables [H R ~> kg m-2 or kg2 m-5]. Angstrom = GV%Angstrom_H @@ -1451,7 +1451,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(inout) :: d_eb !< The downward increase across a layer in the !! layer in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by a layer. - real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(inout) :: htot !< The accumulated mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature !! [C H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity @@ -1892,7 +1892,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real :: h_tgt_old ! The previous thickness of the recipient layer [H ~> m or kg m-2] real :: I_hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m3 kg-1] real :: dT_dS_wt2 ! The square of the relative weighting of temperature and salinity changes - ! when extraploating to match a target density [C2 S-2 ~> degC2 ppt-2] + ! when extrapolating to match a target density [C2 S-2 ~> degC2 ppt-2] real :: dT_dR ! The ratio of temperature changes to density changes when ! extrapolating [C R-1 ~> degC m3 kg-1] real :: dS_dR ! The ratio of salinity changes to density changes when @@ -2262,13 +2262,16 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: h_det_h2 ! The amount of detrained water and mixed layer ! water that will go directly into the lower ! buffer layer [H ~> m or kg m-2]. - real :: h_det_to_h2, h_ml_to_h2 ! All of the variables hA_to_hB are the thickness fluxes - real :: h_det_to_h1, h_ml_to_h1 ! from one layer to another [H ~> m or kg m-2], - real :: h1_to_h2, h1_to_k0 ! with h_det the detrained water, h_ml - real :: h2_to_k1, h2_to_k1_rem ! the actively mixed layer, h1 and h2 the upper - ! and lower buffer layers, and k0 and k1 the - ! interior layers that are just lighter and - ! just denser than the lower buffer layer. + + real :: h_det_to_h2, h_ml_to_h2 ! The fluxes of detrained and mixed layer water to + ! the lower buffer layer [H ~> m or kg m-2]. + real :: h_det_to_h1, h_ml_to_h1 ! The fluxes of detrained and mixed layer water to + ! the upper buffer layer [H ~> m or kg m-2]. + real :: h1_to_h2, h1_to_k0 ! The fluxes of upper buffer layer water to the lower buffer layer + ! and to an interior layer that is just denser than the lower + ! buffer layer [H ~> m or kg m-2]. + real :: h2_to_k1, h2_to_k1_rem ! Fluxes of lower buffer layer water to the interior layer that + ! is just denser than the lower buffer layer [H ~> m or kg m-2]. real :: R0_det, T_det, S_det ! Detrained values of R0 [R ~> kg m-3], T [C ~> degC] and S [S ~> ppt] real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer [R ~> kg m-3] From 05c2983273ba5cb3875b6e011156dd14414df2bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:28:24 -0500 Subject: [PATCH 160/213] Clean up of a get_param call in vertvisc_init Revised the line breaks for a get_param call in vertvisc_init to put the units, default, and scale arguments on the same line, and used a merged scaling factor in the same call. Also added or amended comments to document the units of 9 internal variables in this same file. All answers and output are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 25 ++++++++++--------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 6488ba5b1b..819b2ea8b3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -84,8 +84,8 @@ module MOM_vert_friction !! will often equal CFL_trunc. real :: truncRampTime !< The time-scale over which to ramp up the value of !! CFL_trunc from CFL_truncS to CFL_truncE [T ~> s] - real :: CFL_truncS !< The start value of CFL_trunc - real :: CFL_truncE !< The end/target value of CFL_trunc + real :: CFL_truncS !< The start value of CFL_trunc [nondim] + real :: CFL_truncE !< The end/target value of CFL_trunc [nondim] logical :: CFLrampingIsActivated = .false. !< True if the ramping has been initialized type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts @@ -209,7 +209,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va !! for a column real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the !! bottom, normalized by the GL90 bottom - !! boundary layer thickness + !! boundary layer thickness [nondim] real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated !! with GL90 across interfaces; is not !! included in a_cpl [Z T-1 ~> m s-1]. @@ -362,7 +362,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! by the density [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: accel_underflow ! An acceleration magnitude that is so small that values that are less ! than this are diagnosed as 0 [L T-2 ~> m s-2]. - real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. + real :: zDS, h_a ! Temporary thickness variables used with direct_stress [H ~> m or kg m-2] + real :: hfr ! Temporary ratio of thicknesses used with direct_stress [nondim] 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(:,:,:) :: KE_term ! A term in the kinetic energy budget @@ -982,8 +983,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) I_Hbbl_gl90, &! The inverse of the bottom boundary layer thickness used for the GL90 scheme ! [H-1 ~> m-1 or m2 kg-1]. I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. - zcol1, & ! The height of the interfaces to the north and south of a - zcol2, & ! v-point [H ~> m or kg m-2]. + zcol1, & ! The height of the interfaces to the south of a v-point [H ~> m or kg m-2]. + zcol2, & ! The height of the interfaces to the north of a v-point [H ~> m or kg m-2]. Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2]. Dmin, & ! The shallower of the two adjacent bottom depths converted to ! thickness units [H ~> m or kg m-2]. @@ -1520,7 +1521,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, z_t, & ! The distance from the top, sometimes normalized ! by Hmix, [H ~> m or kg m-2] or [nondim]. kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. - tbl_thick + tbl_thick ! The thickness of the top boundary layer [H ~> m or kg m-2] real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. @@ -1921,8 +1922,8 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables - real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. + real :: maxvel ! Velocities components greater than maxvel are truncated [L T-1 ~> m s-1] + real :: truncvel ! The speed to which velocity components greater than maxvel are set [L T-1 ~> m s-1] real :: CFL ! The local CFL number [nondim] real :: H_report ! A thickness below which not to report truncations [H ~> m or kg m-2] real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] @@ -2262,9 +2263,9 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "viscosity coefficient. This method is valid in stacked shallow water mode.", & default=.false.) call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & - "The scalar diffusivity used in GL90 vertical viscosity "//& - "scheme.", units="m2 s-1", default=0.0, & - scale=US%m_to_Z**2*US%T_to_s, do_not_log=.not.CS%use_GL90_in_SSW) + "The scalar diffusivity used in GL90 vertical viscosity scheme.", & + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, & + do_not_log=.not.CS%use_GL90_in_SSW) call get_param(param_file, mdl, "READ_KD_GL90", CS%read_kappa_gl90, & "If true, read a file (given by KD_GL90_FILE) containing the "//& "spatially varying diffusivity KD_GL90 used in the GL90 scheme.", default=.false., & From f9649d392d0f4ed1ff1ed067123836c72e29c2e4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:30:15 -0500 Subject: [PATCH 161/213] Document units of 14 variables in MOM_tidal_mixing Added or amended comments to document the units of 14 internal variables in MOM_tidal_mixing.F90. Only comments are changed, and all answers are bitwise identical. --- .../vertical/MOM_tidal_mixing.F90 | 31 ++++++++++++------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 4380ceb4bd..23b37bd26d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -50,7 +50,7 @@ module MOM_tidal_mixing real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: N2_int(:,:,:) !< Buoyancy frequency squared at interfaces [T-2 ~> s-2] real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition vertical fraction [nondim]? - real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme, in UNITS? + real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme [nondim] real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces @@ -123,7 +123,7 @@ module MOM_tidal_mixing real :: utide !< constant tidal amplitude [Z T-1 ~> m s-1] if READ_TIDEAMP is false. real :: kappa_itides !< topographic wavenumber and non-dimensional scaling [Z-1 ~> m-1]. - real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height + real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height [nondim] character(len=200) :: inputdir !< The directory in which to find input files logical :: use_CVMix_tidal = .false. !< true if CVMix is to be used for determining @@ -157,7 +157,7 @@ module MOM_tidal_mixing real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided !! by the bottom stratification [R Z3 T-2 ~> J m-2]. real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1]. - real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input + real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input [nondim] real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2]. real, allocatable :: tideamp(:,:) !< RMS tidal amplitude [Z T-1 ~> m s-1] real, allocatable :: h_src(:) !< tidal constituent input layer thickness [m] @@ -240,8 +240,12 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di character(len=200) :: filename, h2_file, Niku_TKE_input_file ! Input file names character(len=200) :: tideamp_file ! Input file names or paths character(len=80) :: tideamp_var, rough_var, TKE_input_var ! Input file variable names - real :: utide, hamp, prandtl_tidal, max_frac_rough - real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data + real :: hamp ! The magnitude of the sub-gridscale bottom depth variance [Z ~> m] + real :: utide ! The RMS tidal amplitude [Z T-1 ~> m s-1] + real :: max_frac_rough ! A limit on the depth variance as a fraction of the total depth [nondim] + real :: prandtl_tidal ! Prandtl number used by CVMix tidal mixing schemes to convert vertical + ! diffusivities into viscosities [nondim] + real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data [nondim] integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -543,11 +547,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di if (CS%Lee_wave_dissipation) then - call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & + call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE", Niku_TKE_input_file, & "The path to the file containing the TKE input from lee "//& "wave driven mixing. Used with LEE_WAVE_DISSIPATION.", & fail_if_missing=.true.) - call get_param(param_file, mdl, "NIKURASHIN_SCALE",Niku_scale, & + call get_param(param_file, mdl, "NIKURASHIN_SCALE", Niku_scale, & "A non-dimensional factor by which to scale the lee-wave "//& "driven TKE input. Used with LEE_WAVE_DISSIPATION.", & units="nondim", default=1.0) @@ -590,7 +594,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di "Prandtl number used by CVMix tidal mixing schemes "//& "to convert vertical diffusivities into viscosities.", & units="nondim", default=1.0, do_not_log=.true.) - call CVMix_put(CS%CVMix_glb_params,'Prandtl',prandtl_tidal) + call CVMix_put(CS%CVMix_glb_params, 'Prandtl', prandtl_tidal) call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & "The type of input tidal energy flux dataset. Valid values are"//& @@ -776,7 +780,9 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] real, dimension(SZK_(GV)+1) :: vert_dep ! vertical deposition [nondim] real, dimension(SZK_(GV)+1) :: iFaceHeight ! Height of interfaces [m] - real, dimension(SZK_(GV)+1) :: SchmittnerSocn + real, dimension(SZK_(GV)+1) :: SchmittnerSocn ! A larger value of the Schmittner coefficint to + ! use in the Southern Ocean [nondim]. If this is smaller + ! than Schmittner_coeff, that standard value is used. real, dimension(SZK_(GV)) :: cellHeight ! Height of cell centers [m] real, dimension(SZK_(GV)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input ! to model coordinates [R Z3 T-3 ~> W m-2] @@ -784,7 +790,10 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int real, dimension(SZK_(GV)) :: Schmittner_coeff ! A coefficient in the Schmittner et al (2014) mixing ! parameterization [nondim] real, dimension(SZK_(GV)) :: h_m ! Cell thickness [m] - real, allocatable, dimension(:,:) :: exp_hab_zetar + real, allocatable, dimension(:,:) :: exp_hab_zetar ! A badly documented array that appears to be + ! related to the distribution of tidal mixing energy, with unusual array + ! extents that are not explained, that is set and used by the CVMix + ! tidal mixing schemes, perhaps in [m3 kg-1]? real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] real :: Simmons_coeff ! A coefficient in the Simmons et al (2004) mixing parameterization [nondim] @@ -1628,7 +1637,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local variables - real, parameter :: C1_3 = 1.0/3.0 + real, parameter :: C1_3 = 1.0/3.0 ! A rational constant [nondim] real, dimension(SZI_(G),SZJ_(G)) :: & tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert [nondim] tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert [nondim] From 6927909fbda79e75576fcb36c343fee8a4260d32 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:30:42 -0500 Subject: [PATCH 162/213] Document units of a variable in MOM_ALE_sponge Amended comments to document the units of 1 internal variable in MOM_ALE_sponge.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 2e2a3edf07..584ccccc93 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -78,7 +78,7 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file - real :: scale = 1.0 !< A multiplicative factor by which to rescale input data + real :: scale = 1.0 !< A multiplicative factor by which to rescale input data [various] real, dimension(:,:), pointer :: p => NULL() !< pointer to the data [various] real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid [H ~> m or kg m-2] character(len=:), allocatable :: name !< The name of the input field From 536d649155bdff990023e9aa5078e4c9136245c4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:31:16 -0500 Subject: [PATCH 163/213] Document units of a variable in MOM_kappa_shear Amended comments to document the units of 1 internal variable in MOM_kappa_shear.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_kappa_shear.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index a1a5a22322..4e07b1d8ed 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -664,8 +664,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa]. T_int, & ! The temperature interpolated to an interface [C ~> degC]. Sal_int, & ! The salinity interpolated to an interface [S ~> ppt]. - dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z T-2 C-1 ~> m s-2 degC-1] and [Z T-2 S-1 ~> m s-2 ppt-1]. + dbuoy_dT, & ! The partial derivative of buoyancy with changes in temperature [Z T-2 C-1 ~> m s-2 degC-1] + dbuoy_dS, & ! The partial derivative of buoyancy with changes in salinity [Z T-2 S-1 ~> m s-2 ppt-1] I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [T ~> s]. From 5c28263e861c0ec5f517cc0e1e659528d9aaca86 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:33:33 -0500 Subject: [PATCH 164/213] Document units of an argument to find_maxF_kb Amended comments to document the units of an argument to the private subroutine find_maxF_kb in MOM_entrainment_diffusive.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 332321b209..51a28db0e9 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -1814,9 +1814,9 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & !! limited value at ent=max_ent_in in this !! array [H ~> m or kg m-2]. real, dimension(SZI_(G)), & - optional, intent(in) :: F_thresh !< If F_thresh is present, return the first - !! value found that has F > F_thresh, or - !! the maximum. + optional, intent(in) :: F_thresh !< If F_thresh is present, return the first value + !! found that has F > F_thresh [H ~> m or kg m-2], or + !! the maximum root if it is absent. ! Maximize F = ent*ds_kb*I_dSkbp1 in the range min_ent < ent < max_ent. ! ds_kb may itself be limited to positive values in determine_dSkb, which gives From 6f5c2f42f6210189a0bad16239a4929f799e1aea Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:34:20 -0500 Subject: [PATCH 165/213] Document units of 2 variables in MOM_CVMix_KPP Amended comments to document the units of 2 internal variables in MOM_CVMix_KPP.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 3ac31ef466..0127f8c556 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -619,7 +619,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [nondim] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [nondim] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier [nondim] ! Local variables integer :: i, j, k ! Loop indices @@ -920,7 +920,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor [nondim] ! Local variables ! Variables for passing to CVMix routines, often in MKS units From 9f53a8ecbeef1530c51a06a24356acfb91d9ec10 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:34:46 -0500 Subject: [PATCH 166/213] Document units of 3 variables in MOM_CVMix_conv Amended comments to document the units of 3 internal variables in MOM_CVMix_conv.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_CVMix_conv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index a0b24dee70..e26c061929 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -57,7 +57,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convection control structure - real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. + real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities [nondim] logical :: useEPBL !< If True, use the ePBL boundary layer scheme. ! This include declares and sets the variable "version". @@ -154,10 +154,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) !! here [Z2 T-1 ~> m2 s-1]. ! local variables - real, dimension(SZK_(GV)) :: rho_lwr !< Adiabatic Water Density, this is a dummy + real, dimension(SZK_(GV)) :: rho_lwr !< Adiabatic Water Density [kg m-3], this is a dummy !! variable since here convection is always !! computed based on Brunt Vaisala. - real, dimension(SZK_(GV)) :: rho_1d !< water density in a column, this is also + real, dimension(SZK_(GV)) :: rho_1d !< water density in a column [kg m-3], this is also !! a dummy variable, same reason as above. real, dimension(SZK_(GV)+1) :: N2 !< Squared buoyancy frequency [s-2] real, dimension(SZK_(GV)+1) :: kv_col !< Viscosities at interfaces in the column [m2 s-1] From b29ed5c37a04236e017e8d5fefc11c89614c2a16 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:35:16 -0500 Subject: [PATCH 167/213] Document units of a variable in MOM_bkgnd_mixing Amended comments to document the units of 1 internal variable in MOM_bkgnd_mixing.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 6d016aa18b..12a32e7376 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -116,7 +116,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL ! Local variables real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set Prandtl ! number unless it is provided as a parameter - real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. + real :: prandtl_bkgnd_comp ! Kv/CS%Kd [nondim]. Gets compared with user-specified prandtl_bkgnd. ! This include declares and sets the variable "version". # include "version_variable.h" From aa0ec8ccf5b355a355e6735aeceb9b32098be62a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:35:42 -0500 Subject: [PATCH 168/213] Document units of a variable in MOM_regularize_layers Amended comments to document the units of 1 internal variable in MOM_regularize_layers.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_regularize_layers.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index bb81d367c6..5380b4cda0 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -142,7 +142,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) S_2d, & ! A 2-d version of tv%S [S ~> ppt]. Rcv, & ! A 2-d version of the coordinate density [R ~> kg m-3]. h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. - T_2d_init, & ! THe initial value of T_2d [C ~> degC]. + T_2d_init, & ! The initial value of T_2d [C ~> degC]. S_2d_init, & ! The initial value of S_2d [S ~> ppt]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -176,8 +176,8 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real :: h_add ! The thickness to add to the layers above an interface [H ~> m or kg m-2] real :: h_det_tot ! The total thickness detrained by the mixed layers [H ~> m or kg m-2] real :: max_def_rat ! The maximum value of the ratio of the thickness deficit to the minimum depth [nondim] - real :: Rcv_min_det ! The lightest (min) and densest (max) coordinate density - real :: Rcv_max_det ! that can detrain into a layer [R ~> kg m-3]. + real :: Rcv_min_det ! The lightest coordinate density that can detrain into a layer [R ~> kg m-3] + real :: Rcv_max_det ! The densest coordinate density that can detrain into a layer [R ~> kg m-3] real :: int_top, int_bot ! The interface depths above and below a layer [H ~> m or kg m-2], positive upward. real :: h_predicted ! An updated thickness [H ~> m or kg m-2] From fdab7fd3efd24e2baa9b2751b2ee4a6aae3750cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:36:08 -0500 Subject: [PATCH 169/213] Document units of a variable in MOM_set_viscosity Amended comments to document the units of 1 internal variable in MOM_set_viscosity.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 91c85ced26..2a9e7deeba 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -257,8 +257,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! the depth of each interface [nondim]. real :: L_direct ! The value of L above volume Vol_direct [nondim]. real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. - real :: Vol_err_max ! The volume errors for the upper and lower bounds on - real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. + real :: Vol_err_max ! The volume error for the upper bound on the correct value for L [H ~> m or kg m-2] + real :: Vol_err_min ! The volume error for the lower bound on the correct value for L [H ~> m or kg m-2] real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. real :: L0 ! The value of L above volume Vol_0 [nondim]. real :: dVol ! vol - Vol_0 [H ~> m or kg m-2]. From cf846eb61c22e0e2314010d441686b6538774c37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:36:42 -0500 Subject: [PATCH 170/213] Document units of 7 variables in MOM_sponge Amended comments to document the units of 7 internal variables, arguments or elements of types in MOM_sponge.F90. Only comments are changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_sponge.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 48e9320c8e..0ef732a024 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -30,11 +30,11 @@ module MOM_sponge !> A structure for creating arrays of pointers to 3D arrays type, public :: p3d - real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array + real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array [various] end type p3d !> A structure for creating arrays of pointers to 2D arrays type, public :: p2d - real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array [various] end type p2d !> This control structure holds memory and parameters for the MOM_sponge module @@ -203,15 +203,15 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: sp_val !< The reference profiles of the quantity being registered. + intent(in) :: sp_val !< The reference profiles of the quantity being registered [various] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: f_ptr !< a pointer to the field which will be damped + target, intent(in) :: f_ptr !< a pointer to the field which will be damped [various] integer, intent(in) :: nlay !< the number of layers in this quantity type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that !! is set by a previous call to initialize_sponge. real, dimension(SZJ_(G),SZK_(GV)),& optional, intent(in) :: sp_val_i_mean !< The i-mean reference value for - !! this field with i-mean sponges. + !! this field with i-mean sponges [various] integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -331,11 +331,11 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) eta_anom, & ! Anomalies in the interface height, relative to the i-mean ! target value [Z ~> m]. fld_anom ! Anomalies in a tracer concentration, relative to the - ! i-mean target value. + ! i-mean target value [various] real, dimension(SZJ_(G), SZK_(GV)+1) :: & eta_mean_anom ! The i-mean interface height anomalies [Z ~> m]. real, allocatable, dimension(:,:,:) :: & - fld_mean_anom ! THe i-mean tracer concentration anomalies. + fld_mean_anom ! The i-mean tracer concentration anomalies [various] real, dimension(SZI_(G), SZK_(GV)+1) :: & h_above, & ! The total thickness above an interface [H ~> m or kg m-2]. h_below ! The total thickness below an interface [H ~> m or kg m-2]. From 7e7b279054c01221593082022f5d28b484a09778 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 06:37:47 -0500 Subject: [PATCH 171/213] Document units of variables in MOM_internal_tides Added or amended comments to document the units of numerous internal variables in MOM_internal_tides.F90, and corrected a few spelling errors in comments. Only comments are changed, and all answers are bitwise identical. --- .../lateral/MOM_internal_tides.F90 | 232 ++++++++++-------- 1 file changed, 126 insertions(+), 106 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 0f951b355a..6dda4c1b1c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -64,9 +64,9 @@ module MOM_internal_tides !! is possible (i.e. ridge cells) ! (could be in G control structure) real, allocatable, dimension(:,:) :: trans - !< partial transmission coeff for each "coast cell" + !< partial transmission coeff for each "coast cell" [nondim] real, allocatable, dimension(:,:) :: residual - !< residual of reflection and transmission coeff for each "coast cell" + !< residual of reflection and transmission coeff for each "coast cell" [nondim] real, allocatable, dimension(:,:,:,:) :: cp !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss @@ -144,7 +144,7 @@ module MOM_internal_tides id_allprocesses_loss_mode, & id_Ub_mode, & id_cp_mode - ! Diag handles considering: all modes, freqs, and angles + ! Diag handles considering: all modes, frequencies, and angles integer, allocatable, dimension(:,:) :: & id_En_ang_mode, & id_itidal_loss_ang_mode @@ -185,7 +185,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & !! mode [L T-1 ~> m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & - test + test ! A test unit vector used to determine grid rotation in halos [nondim] real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only [R Z3 T-2 ~> J m-2] Ub, & ! near-bottom horizontal velocity of wave (modal) [L T-1 ~> m s-1] @@ -196,15 +196,18 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! energy loss rates summed over angle, freq, and mode [R Z3 T-3 ~> W m-2] htot, & ! The vertical sum of the layer thicknesses [H ~> m or kg m-2] drag_scale, & ! bottom drag scale [T-1 ~> s-1] - itidal_loss_mode, allprocesses_loss_mode - ! energy loss rates for a given mode and frequency (summed over angles) [R Z3 T-3 ~> W m-2] - real :: frac_per_sector, f2, Kmag2 + itidal_loss_mode, & ! Energy lost due to small-scale wave drag, summed over angles [R Z3 T-3 ~> W m-2] + allprocesses_loss_mode ! Total energy loss rates for a given mode and frequency (summed over + ! all angles) [R Z3 T-3 ~> W m-2] + real :: frac_per_sector ! The inverse of the number of angular, modal and frequency bins [nondim] + real :: f2 ! The squared Coriolis parameter interpolated to a tracer point [T-2 ~> s-2] + real :: Kmag2 ! A squared horizontal wavenumber [L-2 ~> m-2] real :: I_D_here ! The inverse of the local depth [Z-1 ~> m-1] - real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] - real :: freq2 ! The frequency squared [T-2 ~> s-2] - real :: c_phase ! The phase speed [L T-1 ~> m s-1] + real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] + real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: c_phase ! The phase speed [L T-1 ~> m s-1] real :: loss_rate ! An energy loss rate [T-1 ~> s-1] - real :: Fr2_max + real :: Fr2_max ! The column maximum internal wave Froude number squared [nondim] real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real :: en_subRO ! A tiny energy to prevent division by zero [R Z3 T-2 ~> J m-2] real :: En_new, En_check ! Energies for debugging [R Z3 T-2 ~> J m-2] @@ -223,7 +226,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & cn_subRO = 1e-30*US%m_s_to_L_T en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T - ! init local arrays + ! initialize local arrays drag_scale(:,:) = 0. Ub(:,:,:,:) = 0. @@ -548,7 +551,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%id_TKE_itidal_input > 0) call post_data(CS%id_TKE_itidal_input, & TKE_itidal_input, CS%diag) - ! Output 2-D energy density (summed over angles) for each freq and mode + ! Output 2-D energy density (summed over angles) for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_En_mode(fr,m) > 0) then tot_En(:,:) = 0.0 do a=1,CS%nAngle ; do j=js,je ; do i=is,ie @@ -557,7 +560,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_En_mode(fr,m), tot_En, CS%diag) endif ; enddo ; enddo - ! Output 3-D (i,j,a) energy density for each freq and mode + ! Output 3-D (i,j,a) energy density for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_En_ang_mode(fr,m) > 0) then call post_data(CS%id_En_ang_mode(fr,m), CS%En(:,:,:,fr,m) , CS%diag) endif ; enddo ; enddo @@ -606,7 +609,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_tot_allprocesses_loss, tot_allprocesses_loss, CS%diag) endif - ! Output 2-D energy loss (summed over angles) for each freq and mode + ! Output 2-D energy loss (summed over angles) for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq if (CS%id_itidal_loss_mode(fr,m) > 0 .or. CS%id_allprocesses_loss_mode(fr,m) > 0) then itidal_loss_mode(:,:) = 0.0 ! wave-drag processes (could do others as well) @@ -622,17 +625,17 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_allprocesses_loss_mode(fr,m), allprocesses_loss_mode, CS%diag) endif ; enddo ; enddo - ! Output 3-D (i,j,a) energy loss for each freq and mode + ! Output 3-D (i,j,a) energy loss for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_itidal_loss_ang_mode(fr,m) > 0) then call post_data(CS%id_itidal_loss_ang_mode(fr,m), CS%TKE_itidal_loss(:,:,:,fr,m) , CS%diag) endif ; enddo ; enddo - ! Output 2-D period-averaged horizontal near-bottom mode velocity for each freq and mode + ! Output 2-D period-averaged horizontal near-bottom mode velocity for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_Ub_mode(fr,m) > 0) then call post_data(CS%id_Ub_mode(fr,m), Ub(:,:,fr,m), CS%diag) endif ; enddo ; enddo - ! Output 2-D horizontal phase velocity for each freq and mode + ! Output 2-D horizontal phase velocity for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_cp_mode(fr,m) > 0) then call post_data(CS%id_cp_mode(fr,m), CS%cp(:,:,fr,m), CS%diag) endif ; enddo ; enddo @@ -654,9 +657,10 @@ subroutine sum_En(G, US, CS, En, label) ! Local variables real :: En_sum ! The total energy in MKS units for potential output [J] integer :: a - ! real :: En_sum_diff, En_sum_pdiff + ! real :: En_sum_diff ! Change in energy from the expected value [J] + ! real :: En_sum_pdiff ! Percentage change in energy from the expected value [nondim] ! character(len=160) :: mesg ! The text of an error message - ! real :: days + ! real :: days ! The time in days for use in output messages [days] En_sum = 0.0 do a=1,CS%nAngle @@ -808,29 +812,33 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Local variables integer, parameter :: stencil = 2 real, dimension(SZI_(G),1-stencil:NAngle+stencil) :: & - En2d + En2d ! The internal gravity wave energy density in zonal slices [R Z3 T-2 ~> J m-2] real, dimension(1-stencil:NAngle+stencil) :: & - cos_angle, sin_angle + cos_angle, sin_angle ! The cosine and sine of each angle [nondim] real, dimension(SZI_(G)) :: & - Dk_Dt_Kmag, Dl_Dt_Kmag + Dk_Dt_Kmag, Dl_Dt_Kmag ! Rates of angular refraction [T-1 ~> s-1] real, dimension(SZI_(G),0:nAngle) :: & - Flux_E + Flux_E ! The flux of energy between successive angular wedges within a timestep [R Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),1-stencil:NAngle+stencil) :: & - CFL_ang - real, dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: cn_u !< Internal wave group velocity at U-point - real, dimension(G%isd:G%ied,G%JsdB:G%JedB) :: cn_v !< Internal wave group velocity at V-point - real, dimension(G%isd:G%ied,G%jsd:G%jed) :: cnmask !< Local mask for group velocity + CFL_ang ! The CFL number of angular refraction [nondim] + real, dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: cn_u !< Internal wave group velocity at U-point [L T-1 ~> m s-1] + real, dimension(G%isd:G%ied,G%JsdB:G%JedB) :: cn_v !< Internal wave group velocity at V-point [L T-1 ~> m s-1] + real, dimension(G%isd:G%ied,G%jsd:G%jed) :: cnmask !< Local mask for group velocity [nondim] real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. real :: favg ! The average Coriolis parameter at a point [T-1 ~> s-1]. real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [T-1 L-1 ~> s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [L-1 ~> m-1]. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [L-1 ~> m-1]. - real :: Angle_size, dt_Angle_size, angle - real :: Ifreq, Kmag2, I_Kmag + real :: Angle_size ! The size of each wedge of angles [rad] + real :: dt_Angle_size ! The time step divided by the angle size [T rad-1 ~> s rad-1] + real :: angle ! The central angle of each wedge [rad] + real :: Ifreq ! The inverse of the wave frequency [T ~> s] + real :: Kmag2 ! A squared horizontal wavenumber [L-2 ~> m-2] + real :: I_Kmag ! The inverse of the magnitude of the horizontal wavenumber [L ~> m] real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] integer :: is, ie, js, je, asd, aed, na integer :: i, j, a - real :: wgt1, wgt2 + real :: wgt1, wgt2 ! Weights in an average, both of which may be 0 [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; na = size(En,3) asd = 1-stencil ; aed = NAngle+stencil @@ -938,18 +946,18 @@ end subroutine refract !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the - !! discretized wave energy spectrum. + !! discretized wave energy spectrum [nondim] real, intent(in) :: dt !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a !! function of angular resolution [R Z3 T-2 ~> J m-2]. real, dimension(1-halo_ang:NAngle+halo_ang), & - intent(in) :: CFL_ang !< The CFL number of the energy advection across angles + intent(in) :: CFL_ang !< The CFL number of the energy advection across angles [nondim] real, dimension(0:NAngle), intent(out) :: Flux_En !< The time integrated internal wave energy flux !! across angles [R Z3 T-2 ~> J m-2]. ! Local variables - real :: flux + real :: flux ! The internal wave energy flux across angles [R Z3 T-3 ~> W m-2]. real :: u_ang ! Angular propagation speed [Rad T-1 ~> Rad s-1] real :: Angle_size ! The size of each orientation wedge in radians [Rad] real :: I_Angle_size ! The inverse of the orientation wedges [Rad-1] @@ -1052,11 +1060,16 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss) real, dimension(SZI_(G),SZJB_(G)) :: & speed_y ! The magnitude of the group velocity at the Cv points [L T-1 ~> m s-1]. real, dimension(0:NAngle) :: & - cos_angle, sin_angle + cos_angle, sin_angle ! The cosine and sine of each angle [nondim] real, dimension(NAngle) :: & - Cgx_av, Cgy_av, dCgx, dCgy + Cgx_av, & ! The average projection of the wedge into the x-direction [nondim] + Cgy_av, & ! The average projection of the wedge into the y-direction [nondim] + dCgx, & ! The difference in x-projections between the edges of each angular band [nondim]. + dCgy ! The difference in y-projections between the edges of each angular band [nondim]. real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. - real :: Angle_size, I_Angle_size, angle + real :: Angle_size ! The size of each wedge of angles [rad] + real :: I_Angle_size ! The inverse of the size of each wedge of angles [rad-1] + real :: angle ! The central angle of each wedge [rad] real :: Ifreq ! The inverse of the frequency [T ~> s] real :: freq2 ! The frequency squared [T-2 ~> s-2] type(loop_bounds_type) :: LB @@ -1172,26 +1185,32 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables integer :: i, j, ish, ieh, jsh, jeh, m - real :: TwoPi, Angle_size - real :: energized_angle ! angle through center of current wedge - real :: theta ! angle at edge of wedge - real :: Nsubrays ! number of sub-rays for averaging + real :: TwoPi ! The radius of the circumference of a circle to its radius [nondim] + real :: Angle_size ! The size of each angular wedge [radians] + real :: energized_angle ! angle through center of current wedge [radians] + real :: theta ! angle at edge of each sub-wedge [radians] + real :: Nsubrays ! number of sub-rays for averaging [nondim] ! count includes the two rays that bound the current wedge, ! i.e. those at -dtheta/2 and +dtheta/2 from energized angle - real :: I_Nsubwedges ! inverse of number of sub-wedges - real :: cos_thetaDT, sin_thetaDT ! cos(theta)*dt, sin(theta)*dt - real :: xNE,xNW,xSW,xSE,yNE,yNW,ySW,ySE ! corner point coordinates of advected fluid parcel - real :: CFL_xNE,CFL_xNW,CFL_xSW,CFL_xSE,CFL_yNE,CFL_yNW,CFL_ySW,CFL_ySE,CFL_max - real :: xN,xS,xE,xW,yN,yS,yE,yW ! intersection point coordinates of parcel edges and grid - real :: xCrn,yCrn ! grid point contained within advected fluid parcel - real :: xg,yg ! grid point of interest - real :: slopeN,slopeW,slopeS,slopeE, bN,bW,bS,bE ! parameters defining parcel sides - real :: aNE,aN,aNW,aW,aSW,aS,aSE,aE,aC ! sub-areas of advected parcel - real :: a_total ! total area of advected parcel - ! real :: a1,a2,a3,a4 ! areas used in calculating polygon areas (sub-areas) of advected parcel - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: x,y ! coordinates of cell corners - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: Idx,Idy ! inverse of dx,dy at cell corners - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: dx,dy ! dx,dy at cell corners + real :: I_Nsubwedges ! inverse of number of sub-wedges [nondim] + real :: cos_thetaDT, sin_thetaDT ! cos(theta)*dt, sin(theta)*dt [T ~> s] + real :: xNE, xNW, xSW, xSE ! corner point x-coordinates of advected fluid parcel [L ~> m] + real :: yNE, yNW, ySW, ySE ! corner point y-coordinates of advected fluid parcel [L ~> m] + real :: CFL_xNE, CFL_xNW, CFL_xSW, CFL_xSE ! Various x-direction CFL numbers for propagation [nondim] + real :: CFL_yNE, CFL_yNW, CFL_ySW, CFL_ySE ! Various y-direction CFL numbers for propagation [nondim] + real :: CFL_max ! The maximum of the x- and y-CFL numbers for propagation [nondim] + real :: xN, xS, xE, xW ! intersection point x-coordinates of parcel edges and grid [L ~> m] + real :: yN, yS, yE, yW ! intersection point y-coordinates of parcel edges and grid [L ~> m] + real :: xCrn, yCrn ! Coordinates of grid point contained within advected fluid parcel [L ~> m] + real :: xg, yg ! Positions of grid point of interest [L ~> m] + real :: slopeN, slopeW, slopeS, slopeE ! Coordinate-space slopes of parcel sides [nondim] + real :: bN, bW, bS, bE ! parameters defining parcel sides [L ~> m] + real :: aNE, aN, aNW, aW, aSW, aS, aSE, aE, aC ! sub-areas of advected parcel [L2 ~> m2] + real :: a_total ! total area of advected parcel [L2 ~> m2] + ! real :: a1,a2,a3,a4 ! areas used in calculating polygon areas (sub-areas) of advected parcel [L2 ~> m2] + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: x, y ! coordinates of cell corners [L ~> m] + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: Idx, Idy ! inverse of dx,dy at cell corners [L-1 ~> m-1] + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: dx, dy ! dx,dy at cell corners [L ~> m] real, dimension(2) :: E_new ! Energy in cell after advection for subray [R Z3 T-2 ~> J m-2]; set size ! here to define Nsubrays - this should be made an input option later! @@ -1449,9 +1468,9 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the !! Cu points [L T-1 ~> m s-1]. - real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. + real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band [nondim] real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the - !! edges of each angular band. + !! edges of each angular band [nondim]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control structure @@ -1465,8 +1484,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res real, dimension(SZIB_(G),SZJ_(G)) :: & flux_x ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(SZIB_(G)) :: & - cg_p, flux1 - !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p + cg_p, & ! The x-direction group velocity [L T-1 ~> m s-1] + flux1 ! A 1-d copy of the x-direction internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & Fdt_m, Fdt_p! Left and right energy fluxes [R Z3 L2 T-2 ~> J] integer :: i, j, ish, ieh, jsh, jeh, a @@ -1545,8 +1564,9 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, res EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & flux_y ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. - real, dimension(SZI_(G)) :: cg_p, flux1 - !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p + real, dimension(SZI_(G)) :: & + cg_p, & ! The y-direction group velocity [L T-1 ~> m s-1] + flux1 ! A 1-d copy of the y-direction internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & Fdt_m, Fdt_p! South and north energy fluxes [R Z3 L2 T-2 ~> J] integer :: i, j, ish, ieh, jsh, jeh, a @@ -1823,23 +1843,18 @@ subroutine teleport(En, NAngle, CS, G, LB) real :: TwoPi ! 2*pi = 6.2831853... [nondim] real :: Angle_size ! size of beam wedge [rad] real, dimension(1:NAngle) :: angle_i ! angle of incident ray wrt equator [rad] - real, dimension(1:NAngle) :: cos_angle, sin_angle + real, dimension(1:NAngle) :: cos_angle ! Cosine of the beam angle relative to eastward [nondim] + real, dimension(1:NAngle) :: sin_angle ! Sine of the beam angle relative to eastward [nondim] real :: En_tele ! energy to be "teleported" [R Z3 T-2 ~> J m-2] character(len=160) :: mesg ! The text of an error message integer :: i, j, a - !integer :: isd, ied, jsd, jed ! start and end local indices on data domain - ! ! (values include halos) - !integer :: isc, iec, jsc, jec ! start and end local indices on PE - ! ! (values exclude halos) integer :: ish, ieh, jsh, jeh ! start and end local indices on data domain ! leaving out outdated halo points (march in) integer :: id_g, jd_g ! global (decomposition-invariant) indices integer :: jos, ios ! offsets - real :: cos_normal, sin_normal, angle_wall - ! cos/sin of cross-ridge normal, ridge angle + real :: cos_normal, sin_normal ! cos/sin of cross-ridge normal direction [nondim] + real :: angle_wall ! The coastline angle or the complementary angle [radians] - !isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - !isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh TwoPi = 8.0*atan(1.0) @@ -1909,11 +1924,12 @@ subroutine correct_halo_rotation(En, test, G, NAngle) real, dimension(SZI_(G),SZJ_(G),2), & intent(in) :: test !< An x-unit vector that has been passed through !! the halo updates, to enable the rotation of the - !! wave energies in the halo region to be corrected. + !! wave energies in the halo region to be corrected [nondim]. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. ! Local variables - real, dimension(G%isd:G%ied,NAngle) :: En2d + real, dimension(G%isd:G%ied,NAngle) :: En2d ! A zonal row of the internal gravity wave energy density + ! in a frequency band and mode [R Z3 T-2 ~> J m-2]. integer, dimension(G%isd:G%ied) :: a_shift integer :: i_first, i_last, a_new integer :: a, i, j, isd, ied, jsd, jed, m, fr @@ -1960,18 +1976,19 @@ end subroutine correct_halo_rotation !> Calculates left/right edge values for PPM reconstruction in x-direction. subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. - real, parameter :: oneSixth = 1./6. - real :: h_ip1, h_im1 - real :: dMx, dMn + real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slope in energy density times the cell width [R Z3 T-2 ~> J m-2] + real, parameter :: oneSixth = 1./6. ! One sixth [nondim] + real :: h_ip1, h_im1 ! The energy densities at adjacent points [R Z3 T-2 ~> J m-2] + real :: dMx, dMn ! The maximum and minimum of values of energy density at adjacent points + ! relative to the center point [R Z3 T-2 ~> J m-2] character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil @@ -2034,18 +2051,19 @@ end subroutine PPM_reconstruction_x !> Calculates left/right edge valus for PPM reconstruction in y-direction. subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. - real, parameter :: oneSixth = 1./6. - real :: h_jp1, h_jm1 - real :: dMx, dMn + real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slope in energy density times the cell width [R Z3 T-2 ~> J m-2] + real, parameter :: oneSixth = 1./6. ! One sixth [nondim] + real :: h_jp1, h_jm1 ! The energy densities at adjacent points [R Z3 T-2 ~> J m-2] + real :: dMx, dMn ! The maximum and minimum of values of energy density at adjacent points + ! relative to the center point [R Z3 T-2 ~> J m-2] character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil @@ -2105,22 +2123,24 @@ end subroutine PPM_reconstruction_y !> Limits the left/right edge values of the PPM reconstruction !! to give a reconstruction that is positive-definite. Here this is -!! reinterpreted as giving a constant thickness if the mean thickness is less +!! reinterpreted as giving a constant value if the mean value is less !! than h_min, with a minimum of h_min otherwise. subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Thickness of layer (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value (2D). - real, intent(in) :: h_min !< The minimum thickness that can be - !! obtained by a concave parabolic fit. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in each sector (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value of reconstruction [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value of reconstruction [R Z3 T-2 ~> J m-2] + real, intent(in) :: h_min !< The minimum value that can be + !! obtained by a concave parabolic fit [R Z3 T-2 ~> J m-2] integer, intent(in) :: iis !< Start i-index for computations integer, intent(in) :: iie !< End i-index for computations integer, intent(in) :: jis !< Start j-index for computations integer, intent(in) :: jie !< End j-index for computations ! Local variables - real :: curv, dh, scale - integer :: i,j + real :: curv ! The cell-area normalized curvature [R Z3 T-2 ~> J m-2] + real :: dh ! The difference between the edge values [R Z3 T-2 ~> J m-2] + real :: scale ! A rescaling factor used to give a minimum cell value of at least h_min [nondim] + integer :: i, j do j=jis,jie ; do i=iis,iie ! This limiter prevents undershooting minima within the domain with @@ -2194,12 +2214,12 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure ! Local variables - real :: Angle_size ! size of wedges, rad - real, allocatable :: angles(:) ! orientations of wedge centers, rad + real :: Angle_size ! size of wedges [rad] + real, allocatable :: angles(:) ! orientations of wedge centers [rad] real, dimension(:,:), allocatable :: h2 ! topographic roughness scale squared [Z2 ~> m2] real :: kappa_itides ! characteristic topographic wave number [L-1 ~> m-1] real, dimension(:,:), allocatable :: ridge_temp ! array for temporary storage of flags - ! of cells with double-reflecting ridges + ! of cells with double-reflecting ridges [nondim] logical :: use_int_tides, use_temperature real :: kappa_h2_factor ! A roughness scaling factor [nondim] real :: RMS_roughness_frac ! The maximum RMS topographic roughness as a fraction of the @@ -2431,7 +2451,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) if (trim(refl_angle_file) /= '' ) call MOM_error(FATAL, & "REFL_ANGLE_FILE: "//trim(filename)//" not found") endif - ! replace NANs with null value + ! replace NaNs with null value do j=G%jsc,G%jec ; do i=G%isc,G%iec if (is_NaN(CS%refl_angle(i,j))) CS%refl_angle(i,j) = CS%nullangle enddo ; enddo @@ -2526,7 +2546,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & Time, 'Land mask', 'nondim') - ! Output reflection parameters as diags here (not needed every timestep) + ! Output reflection parameters as diagnostics here (not needed every timestep) if (CS%id_refl_ang > 0) call post_data(CS%id_refl_ang, CS%refl_angle, CS%diag) if (CS%id_refl_pref > 0) call post_data(CS%id_refl_pref, CS%refl_pref, CS%diag) if (CS%id_trans > 0) call post_data(CS%id_trans, CS%trans, CS%diag) @@ -2584,21 +2604,21 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) axes_ang, is_h_point=.true.) do fr=1,CS%nFreq ; write(freq_name(fr), '("freq",i1)') fr ; enddo do m=1,CS%nMode ; do fr=1,CS%nFreq - ! Register 2-D energy density (summed over angles) for each freq and mode + ! Register 2-D energy density (summed over angles) for each frequency and mode write(var_name, '("Itide_En_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy density in frequency ",i1," mode ",i1)') fr, m CS%id_En_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'J m-2', conversion=US%RZ3_T3_to_W_m2*US%T_to_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 3-D (i,j,a) energy density for each freq and mode + ! Register 3-D (i,j,a) energy density for each frequency and mode write(var_name, '("Itide_En_ang_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide angular energy density in frequency ",i1," mode ",i1)') fr, m CS%id_En_ang_mode(fr,m) = register_diag_field('ocean_model', var_name, & axes_ang, Time, var_descript, 'J m-2 band-1', conversion=US%RZ3_T3_to_W_m2*US%T_to_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D energy loss (summed over angles) for each freq and mode + ! Register 2-D energy loss (summed over angles) for each frequency and mode ! wave-drag only write(var_name, '("Itide_wavedrag_loss_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to wave-drag from frequency ",i1," mode ",i1)') fr, m @@ -2612,7 +2632,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 3-D (i,j,a) energy loss for each freq and mode + ! Register 3-D (i,j,a) energy loss for each frequency and mode ! wave-drag only write(var_name, '("Itide_wavedrag_loss_ang_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to wave-drag from frequency ",i1," mode ",i1)') fr, m @@ -2620,14 +2640,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) axes_ang, Time, var_descript, 'W m-2 band-1', conversion=US%RZ3_T3_to_W_m2) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D period-averaged near-bottom horizontal velocity for each freq and mode + ! Register 2-D period-averaged near-bottom horizontal velocity for each frequency and mode write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Near-bottom horizontal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D horizonal phase velocity for each freq and mode + ! Register 2-D horizontal phase velocity for each frequency and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Horizontal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & @@ -2643,7 +2663,7 @@ end subroutine internal_tides_init !> This subroutine deallocates the memory associated with the internal tides control structure subroutine internal_tides_end(CS) - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure if (allocated(CS%En)) deallocate(CS%En) if (allocated(CS%frequency)) deallocate(CS%frequency) From e85260a368dd445f358f026bb087e7e7ceb1d13a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 30 Jan 2023 18:13:38 -0500 Subject: [PATCH 172/213] Document units of variables in MOM_tidal_forcing Added or amended comments to document the units of 13 internal variables in MOM_tidal_forcing.F90, and corrected a few spelling errors in comments. Only comments are changed, and all answers are bitwise identical. --- .../lateral/MOM_tidal_forcing.F90 | 50 ++++++++++--------- 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 63b0ced556..b2fd8f0ea5 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -30,11 +30,10 @@ module MOM_tidal_forcing !! constituents that could be used. !> Simple type to store astronomical longitudes used to calculate tidal phases. type, public :: astro_longitudes - real :: & - s, & !< Mean longitude of moon [rad] - h, & !< Mean longitude of sun [rad] - p, & !< Mean longitude of lunar perigee [rad] - N !< Longitude of ascending node [rad] + real :: s !< Mean longitude of moon [rad] + real :: h !< Mean longitude of sun [rad] + real :: p !< Mean longitude of lunar perigee [rad] + real :: N !< Longitude of ascending node [rad] end type astro_longitudes !> The control structure for the MOM_tidal_forcing module @@ -67,13 +66,15 @@ module MOM_tidal_forcing type(astro_longitudes) :: tidal_longitudes !< Astronomical longitudes used to calculate !! tidal phases at t = 0. real, allocatable :: & - sin_struct(:,:,:), & !< The sine and cosine based structures that can - cos_struct(:,:,:), & !< be associated with the astronomical forcing [nondim]. - cosphasesal(:,:,:), & !< The cosine and sine of the phase of the - sinphasesal(:,:,:), & !< self-attraction and loading amphidromes [nondim]. + sin_struct(:,:,:), & !< The sine based structures that can be associated with + !! the astronomical forcing [nondim]. + cos_struct(:,:,:), & !< The cosine based structures that can be associated with + !! the astronomical forcing [nondim]. + cosphasesal(:,:,:), & !< The cosine of the phase of the self-attraction and loading amphidromes [nondim]. + sinphasesal(:,:,:), & !< The sine of the phase of the self-attraction and loading amphidromes [nondim]. ampsal(:,:,:), & !< The amplitude of the SAL [Z ~> m]. - cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the - sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions [nondim]. + cosphase_prev(:,:,:), & !< The cosine of the phase of the amphidromes in the previous tidal solutions [nondim]. + sinphase_prev(:,:,:), & !< The sine of the phase of the amphidromes in the previous tidal solutions [nondim]. amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. type(sht_CS) :: sht !< Spherical harmonic transforms (SHT) for SAL integer :: sal_sht_Nd !< Maximum degree for SHT [nondim] @@ -95,7 +96,7 @@ module MOM_tidal_forcing !! (their Equation I.71), which are based on Schureman, 1958. !! For simplicity, the time associated with time_ref should !! be at midnight. These formulas also only make sense if -!! the calendar is gregorian. +!! the calendar is Gregorian. subroutine astro_longitudes_init(time_ref, longitudes) type(time_type), intent(in) :: time_ref !> Time to calculate longitudes for. type(astro_longitudes), intent(out) :: longitudes !> Lunar and solar longitudes at time_ref. @@ -128,7 +129,7 @@ end subroutine astro_longitudes_init function eq_phase(constit, longitudes) character (len=2), intent(in) :: constit !> Name of constituent (e.g., M2). type(astro_longitudes), intent(in) :: longitudes !> Mean longitudes calculated using astro_longitudes_init - real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... + real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] real :: eq_phase !> The equilibrium phase argument for the constituent [rad]. select case (constit) @@ -248,13 +249,13 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control structure ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & - phase, & ! The phase of some tidal constituent. - lat_rad, lon_rad ! Latitudes and longitudes of h-points in radians. - real :: deg_to_rad + phase, & ! The phase of some tidal constituent [radians]. + lat_rad, lon_rad ! Latitudes and longitudes of h-points [radians]. + real :: deg_to_rad ! A conversion factor from degrees to radians [radian degree-1] real, dimension(MAX_CONSTITUENTS) :: freq_def ! Default frequency for each tidal constituent [s-1] real, dimension(MAX_CONSTITUENTS) :: phase0_def ! Default reference phase for each tidal constituent [rad] real, dimension(MAX_CONSTITUENTS) :: amp_def ! Default amplitude for each tidal constituent [m] @@ -581,8 +582,8 @@ subroutine calc_love_scaling(nlm, rhoW, rhoE, Love_Scaling) real, dimension(:), intent(out) :: Love_Scaling !< Scaling factors for inverse SHT [nondim] ! Local variables - real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames - real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers + real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames [nondim] + real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers [nondim] integer :: n_tot ! Size of the stored Love numbers integer :: n, m, l @@ -615,8 +616,9 @@ subroutine find_in_files(filenames, varname, array, G, scale) character(len=*), dimension(:), intent(in) :: filenames !< The names of the files to search for the named variable character(len=*), intent(in) :: varname !< The name of the variable to read type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data - real, optional, intent(in) :: scale !< A factor by which to rescale the array. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data [arbitrary] + real, optional, intent(in) :: scale !< A factor by which to rescale the array to translate it + !! into its desired units [arbitrary] ! Local variables integer :: nf @@ -667,7 +669,7 @@ end subroutine tidal_forcing_sensitivity !! column mass anomalies. subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(time_type), intent(in) :: Time !< The time for the caluculation. + type(time_type), intent(in) :: Time !< The time for the calculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height @@ -681,7 +683,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) real :: now ! The relative time compared with the tidal reference [T ~> s] real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m] real :: cosomegat, sinomegat ! The components of the phase [nondim] - real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal [nondim] + real :: eta_prop ! The nondimenional constant of proportionality between eta and eta_tidal [nondim] integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -754,7 +756,7 @@ subroutine calc_SAL_sht(eta, eta_sal, G, CS) !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_sal !< The sea surface height anomaly from !! self-attraction and loading [Z ~> m]. - type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control structure ! Local variables integer :: n, m, l From a139bc4e2fecd24a0d61b93fee92e968308e722c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 30 Jan 2023 18:14:01 -0500 Subject: [PATCH 173/213] Better terminology in thickness_diffuse module Changed the terminology in the thickness_diffuse module to be more accurate, specifically changing phrases like "thickness diffusion" to "isopycnal height diffusion". The two are only the same in the limit of a uniform bottom depth, and isopycnal coordinate and a vertically uniform diffusivity, and the new phrases reflect what is actually being done. In addition, the "Brunt-Vaisala frequency" is now being described as the "buoyancy frequency" for greater clarity of language and less use of jargon. Some units were also added to the descriptions using the standard syntax used elsewhere in the code. For now, these changes are restricted to the internal comments, so that there are no changes in the MOM_parameter_doc or output files. All answers are bitwise identical. --- .../lateral/MOM_thickness_diffuse.F90 | 134 +++++++++--------- 1 file changed, 69 insertions(+), 65 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b4092d3d43..4e12aeeaad 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1,4 +1,4 @@ -!> Thickness diffusion (or Gent McWilliams) +!> Isopycnal height diffusion (or Gent McWilliams diffusion) module MOM_thickness_diffuse ! This file is part of MOM6. See LICENSE.md for the license. @@ -33,17 +33,17 @@ module MOM_thickness_diffuse ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Control structure for thickness diffusion +!> Control structure for thickness_diffuse type, public :: thickness_diffuse_CS ; private logical :: initialized = .false. !< True if this control structure has been initialized. real :: Khth !< Background isopycnal depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [nondim] - real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion [nondim] + real :: max_Khth_CFL !< Maximum value of the diffusive CFL for isopycnal height diffusion [nondim] real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max - real :: Kh_eta_bg !< Background interface height diffusivity [L2 T-1 ~> m2 s-1] + real :: Kh_eta_bg !< Background isopycnal height diffusivity [L2 T-1 ~> m2 s-1] real :: Kh_eta_vel !< Velocity scale that is multiplied by the grid spacing to give - !! the interface height diffusivity [L T-1 ~> m s-1] + !! the isopycnal height diffusivity [L T-1 ~> m s-1] real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. @@ -70,14 +70,14 @@ module MOM_thickness_diffuse logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC !! framework (Marshall et al., 2012) real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of - !! the GEOMETRIC thickness diffusion [nondim] + !! the GEOMETRIC isopycnal height diffusion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness !! diffusivity [T-1 ~> s-1]. integer :: MEKE_GEOM_answer_date !< The vintage of the expressions in the MEKE_GEOMETRIC !! calculation. Values below 20190101 recover the answers from the !! original implementation, while higher values use expressions that !! satisfy rotational symmetry. - logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. + logical :: Use_KH_in_MEKE !< If true, uses the isopycnal height diffusivity calculated here to diffuse MEKE. real :: MEKE_min_depth_diff !< The minimum total depth over which to average the diffusivity !! used for MEKE [H ~> m or kg m-2]. When the total depth is less !! than this, the diffusivity is scaled away. @@ -89,16 +89,16 @@ module MOM_thickness_diffuse !! temperature gradient in the deterministic part of the Stanley parameterization. !! Negative values disable the scheme. [nondim] logical :: read_khth !< If true, read a file containing the spatially varying horizontal - !! thickness diffusivity + !! isopycnal height diffusivity logical :: use_stanley_gm !< If true, also use the Stanley parameterization in MOM_thickness_diffuse type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] + real, allocatable :: GMwork(:,:) !< Work by isopycnal height diffusion [R Z L2 T-3 ~> W m-2] real, allocatable :: diagSlopeX(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, allocatable :: diagSlopeY(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, allocatable :: Kh_eta_u(:,:) !< Interface height diffusivities at u points [L2 T-1 ~> m2 s-1] - real, allocatable :: Kh_eta_v(:,:) !< Interface height diffusivities in v points [L2 T-1 ~> m2 s-1] + real, allocatable :: Kh_eta_u(:,:) !< Isopycnal height diffusivities at u points [L2 T-1 ~> m2 s-1] + real, allocatable :: Kh_eta_v(:,:) !< Isopycnal height diffusivities in v points [L2 T-1 ~> m2 s-1] real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] @@ -116,8 +116,8 @@ module MOM_thickness_diffuse contains -!> Calculates thickness diffusion coefficients and applies thickness diffusion to layer -!! thicknesses, h. Diffusivities are limited to ensure stability. +!> Calculates isopycnal height diffusion coefficients and applies isopycnal height diffusion +!! by modifying to the layer thicknesses, h. Diffusivities are limited to ensure stability. !! Also returns along-layer mass fluxes used in the continuity equation. subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -133,7 +133,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(VarMix_CS), target, intent(in) :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse ! Local variables real :: e(SZI_(G),SZJ_(G),SZK_(GV)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. @@ -141,13 +141,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: vhD(SZI_(G),SZJB_(G),SZK_(GV)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & - KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_u, & ! Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures [nondim]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & - KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + KH_v, & ! Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct @@ -156,23 +156,25 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [L2 T-1 ~> m2 s-1] + KH_u_CFL ! The maximum stable isopycnal height diffusivity at u grid points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [L2 T-1 ~> m2 s-1] + KH_v_CFL ! The maximum stable isopycnal height diffusivity at v grid points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & htot ! The sum of the total layer thicknesses [H ~> m or kg m-2] - real :: Khth_Loc_u(SZIB_(G),SZJ_(G)) - real :: Khth_Loc_v(SZI_(G),SZJB_(G)) + real :: Khth_Loc_u(SZIB_(G),SZJ_(G)) ! The isopycnal height diffusivity at u points [L2 T-1 ~> m2 s-1] + real :: Khth_Loc_v(SZI_(G),SZJB_(G)) ! The isopycnal height diffusivity at v points [L2 T-1 ~> m2 s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] + real :: hu(SZI_(G),SZJ_(G)) ! A thickness-based mask at u points, used for diagnostics [nondim] + real :: hv(SZI_(G),SZJ_(G)) ! A thickness-based mask at v points, used for diagnostics [nondim] + real :: KH_u_lay(SZI_(G),SZJ_(G)) ! Diagnostic of isopycnal height diffusivities at u-points averaged + ! to layer centers [L2 T-1 ~> m2 s-1] + real :: KH_v_lay(SZI_(G),SZJ_(G)) ! Diagnostic of isopycnal height diffusivities at v-points averaged + ! to layer centers [L2 T-1 ~> m2 s-1] logical :: use_VarMix, Resoln_scaled, Depth_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz - real :: hu(SZI_(G),SZJ_(G)) ! u-thickness [H ~> m or kg m-2] - real :: hv(SZI_(G),SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G),SZJ_(G)) ! Thickness diffusivities [L2 T-1 ~> m2 s-1] - real :: KH_v_lay(SZI_(G),SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] if (.not. CS%initialized) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& "Module must be initialized before it is used.") @@ -592,9 +594,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Kh_u !< Isopycnal height diffusivity !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Kh_v !< Isopycnal height diffusivity !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: uhD !< Zonal mass fluxes @@ -604,7 +606,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of @@ -663,8 +665,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV T_hr, & ! Temperature on the interface at the h (+1) point [C ~> degC]. S_hr, & ! Salinity on the interface at the h (+1) point [S ~> ppt]. pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. - real :: Work_u(SZIB_(G),SZJ_(G)) ! The work being done by the thickness - real :: Work_v(SZI_(G),SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W ] + real :: Work_u(SZIB_(G),SZJ_(G)) ! The work done by the isopycnal height diffusion + ! integrated over u-point water columns [R Z L4 T-3 ~> W] + real :: Work_v(SZI_(G),SZJB_(G)) ! The work done by the isopycnal height diffusion + ! integrated over v-point water columns [R Z L4 T-3 ~> W] real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2]. real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. @@ -1436,7 +1440,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (find_work) then ; do j=js,je ; do i=is,ie - ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. + ! Note that the units of Work_v and Work_u are [R Z L4 T-3 ~> W], while Work_h is in [R Z L2 T-3 ~> W m-2]. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) if (allocated(CS%GMwork)) CS%GMwork(i,j) = Work_h @@ -1499,28 +1503,28 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver -!> Add a diffusivity that acts on the interface heights, regardless of the densities +!> Add a diffusivity that acts on the isopycnal heights, regardless of the densities subroutine add_interface_Kh(G, GV, US, CS, Kh_u, Kh_v, Kh_u_CFL, Kh_v_CFL, int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness_diffuse + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Isopycnal height diffusivity !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [L2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Isopycnal height diffusivity !! at v points [L2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable isopycnal height + !! diffusivity at u points [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable isopycnal height + !! diffusivity at v points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration - !! of density gradients. + !! of density gradients [nondim]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration - !! of density gradients. + !! of density gradients [nondim]. ! Local variables integer :: i, j, k, is, ie, js, je, nz @@ -1541,7 +1545,7 @@ subroutine add_interface_Kh(G, GV, US, CS, Kh_u, Kh_v, Kh_u_CFL, Kh_v_CFL, int_s end subroutine add_interface_Kh -!> Modifies thickness diffusivities to untangle layer structures +!> Modifies isopycnal height diffusivities to untangle layer structures subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -1549,17 +1553,17 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [L2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Isopycnal height diffusivity !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Isopycnal height diffusivity !! at v points [L2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable isopycnal height + !! diffusivity at u points [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable isopycnal height + !! diffusivity at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] - type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness_diffuse real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration @@ -1573,10 +1577,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV de_top ! The distances between the top of a layer and the top of the ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & - Kh_lay_u ! The tentative interface height diffusivity for each layer at + Kh_lay_u ! The tentative isopycnal height diffusivity for each layer at ! u points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & - Kh_lay_v ! The tentative interface height diffusivity for each layer at + Kh_lay_v ! The tentative isopycnal height diffusivity for each layer at ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the @@ -1958,7 +1962,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV end subroutine add_detangling_Kh -!> Initialize the thickness diffusion module/structure +!> Initialize the isopycnal height diffusion module and its control structure subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -1967,7 +1971,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation diagnostics - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse ! Local variables character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. @@ -2026,9 +2030,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call pass_var(CS%khth2d, G%domain) endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & - "The nondimensional coefficient in the Visbeck formula "//& - "for the interface depth diffusivity", units="nondim", & - default=0.0) + "The nondimensional coefficient in the Visbeck formula for "//& + "the interface depth diffusivity", units="nondim", default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) @@ -2246,14 +2249,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) end subroutine thickness_diffuse_init -!> Copies ubtav and vbtav from private type into arrays +!> Copies KH_u_GME and KH_v_GME from private type into arrays provided as arguments subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for this module type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< interface height + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< Isopycnal height !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: KH_v_GME !< interface height + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: KH_v_GME !< Isopycnal height !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! Local variables integer :: i,j,k @@ -2268,9 +2271,9 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) end subroutine thickness_diffuse_get_KH -!> Deallocate the thickness diffusion control structure +!> Deallocate the thickness_diffus3 control structure subroutine thickness_diffuse_end(CS, CDp) - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity diagnostic control structure if (CS%id_slope_x > 0) deallocate(CS%diagSlopeX) @@ -2292,9 +2295,9 @@ end subroutine thickness_diffuse_end !> \namespace mom_thickness_diffuse !! -!! \section section_gm Thickness diffusion (aka Gent-McWilliams) +!! \section section_gm Isopycnal height diffusion (aka Gent-McWilliams) !! -!! Thickness diffusion is implemented via along-layer mass fluxes +!! Isopycnal height diffusion is implemented via along-layer mass fluxes !! \f[ !! h^\dagger \leftarrow h^n - \Delta t \nabla \cdot ( \vec{uh}^* ) !! \f] @@ -2304,7 +2307,8 @@ end subroutine thickness_diffuse_end !! \vec{uh}^* = \delta_k \vec{\psi} . !! \f] !! -!! The GM implementation of thickness diffusion made the streamfunction proportional to the potential density slope +!! The GM implementation of isopycnal height diffusion made the streamfunction proportional +!! to the potential density slope !! \f[ !! \vec{\psi} = - \kappa_h \frac{\nabla_z \rho}{\partial_z \rho} !! = \frac{g\kappa_h}{\rho_o} \frac{\nabla \rho}{N^2} = \kappa_h \frac{M^2}{N^2} @@ -2324,12 +2328,12 @@ end subroutine thickness_diffuse_end !! which recovers the previous streamfunction relation in the limit that \f$ c \rightarrow 0 \f$. !! Here, \f$c=\max(c_{min},c_g)\f$ is the maximum of either \f$c_{min}\f$ and either the first baroclinic mode !! wave-speed or the equivalent barotropic mode wave-speed. -!! \f$N_*^2 = \max(N^2,0)\f$ is a non-negative form of the square of the Brunt-Vaisala frequency. +!! \f$N_*^2 = \max(N^2,0)\f$ is a non-negative form of the square of the buoyancy frequency. !! The parameter \f$\gamma_F\f$ is used to reduce the vertical smoothing length scale. !! \f[ !! \kappa_h = \left( \kappa_o + \alpha_{s} L_{s}^2 < S N > + \alpha_{M} \kappa_{M} \right) r(\Delta x,L_d) !! \f] -!! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the Brunt-Vaisala frequency, +!! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the buoyancy frequency, !! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and !! \f$ r(\Delta x,L_d) \f$ is a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, !! to deformation radius, \f$L_d\f$). The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module From f6b4a7d8c52ffa58b10d37b0fdc5bce07039619b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Jan 2023 15:14:08 -0500 Subject: [PATCH 174/213] (*)Fix MEKE scaling issues with SmartRedis options This commit fixed a number of dimensional rescaling issues that were introduced to the MOM_MEKE code switch the SmartRedis related options. Specifically, it adds a missing scale factor for the time_interp_external call for the offline data Eddy kinetic energy used in MEKE when EKE_SOURCE=file. It also corrects the documented units and conversion factors for 4 diagnostics related to machine learning within MEKE. This commit also adds or amends comments to document the units of 27 internal variables in MOM_MEKE.F90, and corrected a few spelling errors in comments. All answers and output are bitwise identical in the existing MOM6-examples test suite, but there may be other examples where the units or rescaling of diagnostics are corrected or (in cases using EKE_SOURCE=file) where dimensional consistency testing issues are corrected for the solutions themselves. --- src/parameterizations/lateral/MOM_MEKE.F90 | 104 +++++++++++---------- 1 file changed, 55 insertions(+), 49 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 013cfd386a..8d6eda728d 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -45,7 +45,7 @@ module MOM_MEKE integer, parameter :: RV_IDX = 3 !< Index of surface relative vorticity in the feature array integer, parameter :: RD_DX_Z_IDX = 4 !< Index of the radius of deformation over the grid size in the feature array -integer, parameter :: EKE_PROG = 1 !< Use prognostic equation to calcualte EKE +integer, parameter :: EKE_PROG = 1 !< Use prognostic equation to calculate EKE integer, parameter :: EKE_FILE = 2 !< Read in EKE from a file integer, parameter :: EKE_DBCLIENT = 3 !< Infer EKE using a neural network @@ -141,7 +141,7 @@ module MOM_MEKE logical :: online_analysis !< If true, post the EKE used in MOM6 at every timestep character(len=5) :: model_key = 'mleke' !< Key where the ML-model is stored character(len=7) :: key_suffix !< Suffix appended to every key sent to Redis - real :: eke_max !< The maximum value of EKE considered physically reasonable + real :: eke_max !< The maximum value of EKE considered physically reasonable [L2 T-2 ~> m2 s-2] ! Clock ids integer :: id_client_init !< Clock id to time initialization of the client @@ -173,22 +173,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumulated zonal mass flux [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumulated meridional mass flux [H L2 ~> m3 or kg] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(in) :: tv !< Type containing thermodynamic variables type(time_type), intent(in) :: Time !< The time used for interpolating EKE ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - data_eke, & ! EKE from file + data_eke, & ! EKE from file [L2 T-2 ~> m2 s-2] mass, & ! The total mass of the water column [R Z ~> kg m-2]. I_mass, & ! The inverse of mass [R-1 Z-1 ~> m2 kg-1]. depth_tot, & ! The depth of the water column [Z ~> m]. src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3). MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. - drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] + drag_rate_visc, & ! Near-bottom velocity contribution to bottom drag [L T-1 ~> m s-1] drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2]. del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2]. @@ -196,7 +196,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2, & ! Ratio of EKE_bottom / EKE [nondim] tmp, & ! Temporary variable for computation of diagnostic velocities [L T-1 ~> m s-1] - equilibrium_value ! The equilbrium value of MEKE to be calculated at each + equilibrium_value ! The equilibrium value of MEKE to be calculated at each ! time step [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -225,7 +225,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real(kind=real32), dimension(size(MEKE%MEKE),NUM_FEATURES) :: features_array + real(kind=real32), dimension(size(MEKE%MEKE),NUM_FEATURES) :: features_array ! The array of features + ! needed for the machine learning inference, with different + ! units for the various subarrays [various] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -625,7 +627,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif case(EKE_FILE) - call time_interp_external(CS%id_eke,Time,data_eke) + call time_interp_external(CS%id_eke, Time, data_eke, scale=US%m_s_to_L_T**2) do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = data_eke(i,j) * G%mask2dT(i,j) enddo; enddo @@ -755,7 +757,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. ! Local variables - real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: beta ! Combined topographic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] real :: SN ! The local Eady growth rate [T-1 ~> s-1] real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim] real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m] @@ -955,7 +957,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady ! Possible mixing length scales [L ~> m] - real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: beta ! Combined topographic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] real :: SN ! The local Eady growth rate [T-1 ~> s-1] real :: FatH ! Coriolis parameter at h points [T-1 ~> s-1] real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] @@ -1094,7 +1096,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure logical, intent( out) :: meke_in_dynamics !< If true, MEKE is stepped forward in dynamics !! otherwise in tracer dynamics @@ -1230,7 +1232,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, case default call MOM_error(FATAL, "Invalid method selected for calculating EKE") end select - ! GMM, make sure all params used to calculated MEKE are within the above if + ! GMM, make sure all parameters used to calculated MEKE are within the above if call get_param(param_file, mdl, "MEKE_KHCOEFF", CS%MEKE_KhCoeff, & "A scaling factor in the expression for eddy diffusivity "//& @@ -1560,13 +1562,13 @@ subroutine ML_MEKE_init(diag, G, US, Time, param_file, dbcomms_CS, CS) CS%id_mke = register_diag_field('ocean_model', 'MEKE_MKE', diag%axesT1, Time, & 'Surface mean (resolved) kinetic energy used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) CS%id_slope_z= register_diag_field('ocean_model', 'MEKE_slope_z', diag%axesT1, Time, & - 'Vertically averaged isopyncal slope magnitude used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) + 'Vertically averaged isopyncal slope magnitude used in MEKE', 'nondim', conversion=US%Z_to_L) CS%id_slope_x= register_diag_field('ocean_model', 'MEKE_slope_x', diag%axesCui, Time, & - 'Isopycnal slope in the x-direction used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) + 'Isopycnal slope in the x-direction used in MEKE', 'nondim', conversion=US%Z_to_L) CS%id_slope_y= register_diag_field('ocean_model', 'MEKE_slope_y', diag%axesCvi, Time, & - 'Isopycnal slope in the y-direction used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) - CS%id_rv= register_diag_field('ocean_model', 'MEKE_RV', diag%axesT1, Time, & - 'Surface relative vorticity used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) + 'Isopycnal slope in the y-direction used in MEKE', 'nondim', conversion=US%Z_to_L) + CS%id_rv = register_diag_field('ocean_model', 'MEKE_RV', diag%axesT1, Time, & + 'Surface relative vorticity used in MEKE', 's-1', conversion=US%s_to_T) end subroutine ML_MEKE_init @@ -1574,35 +1576,38 @@ end subroutine ML_MEKE_init subroutine ML_MEKE_calculate_features(G, GV, US, CS, Rd_dx_h, u, v, tv, h, dt, features_array) type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), intent(in) :: CS !< Control structure for MEKE - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: Rd_dx_h !< Rossby radius of deformation over - !! the grid length scale [nondim] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: Rd_dx_h !< Rossby radius of deformation over + !! the grid length scale [nondim] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(in) :: tv !< Type containing thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. + real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. real(kind=real32), dimension(SIZE(h),num_features), intent( out) :: features_array - !< The array of features needed for machine - !! learning inference - - real, dimension(SZI_(G),SZJ_(G)) :: mke - real, dimension(SZI_(G),SZJ_(G)) :: slope_z - real, dimension(SZIB_(G),SZJB_(G)) :: rv_z - real, dimension(SZIB_(G),SZJB_(G)) :: rv_z_t - real, dimension(SZI_(G),SZJ_(G)) :: rd_dx_z - - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)) :: h_u ! Thickness at u point - real, dimension(SZI_(G),SZJB_(G), SZK_(G)) :: h_v ! Thickness at v point - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: slope_x ! Isoneutral slope at U point - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: slope_y ! Isoneutral slope at V point - real, dimension(SZIB_(G),SZJ_(G)) :: slope_x_vert_avg ! Isoneutral slope at U point - real, dimension(SZI_(G),SZJB_(G)) :: slope_y_vert_avg ! Isoneutral slope at V point + !< The array of features needed for machine + !! learning inference, with different units + !! for the various subarrays [various] + + real, dimension(SZI_(G),SZJ_(G)) :: mke ! Surface kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJ_(G)) :: slope_z ! Vertically averaged isoneutral slopes [Z L-1 ~> nondim] + real, dimension(SZIB_(G),SZJB_(G)) :: rv_z ! Surface relative vorticity [T-1 ~> s-1] + real, dimension(SZIB_(G),SZJB_(G)) :: rv_z_t ! Surface relative vorticity interpolated to tracer points [T-1 ~> s-1] + + real, dimension(SZIB_(G),SZJ_(G), SZK_(G)) :: h_u ! Thickness at u point [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJB_(G), SZK_(G)) :: h_v ! Thickness at v point [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: slope_x ! Isoneutral slope at U point [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: slope_y ! Isoneutral slope at V point [Z L-1 ~> nondim] + real, dimension(SZIB_(G),SZJ_(G)) :: slope_x_vert_avg ! Isoneutral slope at U point [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G)) :: slope_y_vert_avg ! Isoneutral slope at V point [Z L-1 ~> nondim] real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. - real :: slope_t, u_t, v_t ! u and v interpolated to thickness point - real :: dvdx, dudy - real :: a_e, a_w, a_n, a_s, Idenom, sum_area + real :: slope_t ! Slope interpolated to thickness points [Z L-1 ~> nondim] + real :: u_t, v_t ! u and v interpolated to thickness points [L T-1 ~> m s-1] + real :: dvdx, dudy ! Components of relative vorticity [T-1 ~> s-1] + real :: a_e, a_w, a_n, a_s ! Fractional areas of neighboring cells for interpolating velocities [nondim] + real :: Idenom ! A normalizing factor in calculating weighted averages of areas [L-2 ~> m-2] + real :: sum_area ! A sum of adjacent cell areas [L2 ~> m2] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -1735,11 +1740,12 @@ end subroutine predict_MEKE !> Compute average of interface quantities weighted by the thickness of the surrounding layers real function vertical_average_interface(h, w, h_min) - real, dimension(:), intent(in) :: h !< Layer Thicknesses - real, dimension(:), intent(in) :: w !< Quantity to average - real, intent(in) :: h_min !< The vanishingly small layer thickness + real, dimension(:), intent(in) :: h !< Layer Thicknesses [H ~> m or kg m-2] + real, dimension(:), intent(in) :: w !< Quantity to average [arbitrary] + real, intent(in) :: h_min !< The vanishingly small layer thickness [H ~> m or kg m-2] - real :: htot, inv_htot + real :: htot ! Twice the sum of the layer thicknesses interpolated to interior interfaces [H ~> m or kg m-2] + real :: inv_htot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1] integer :: k, nk nk = size(h) @@ -1902,7 +1908,7 @@ end subroutine MEKE_end !! The local dissipation of \f$ E \f$ is parameterized through a linear !! damping, \f$\lambda\f$, and bottom drag, \f$ C_d | U_d | \gamma_b^2 \f$. !! The \f$ \gamma_b \f$ accounts for the weak projection of the column-mean -!! eddy velocty to the bottom. In other words, the bottom velocity is +!! eddy velocity to the bottom. In other words, the bottom velocity is !! estimated as \f$ \gamma_b U_e \f$. !! The bottom drag coefficient, \f$ C_d \f$ is the same as that used in the bottom !! friction in the mean model equations. From 454c5c61fa3696d1195a8f7c7a58446ee9658cf1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 28 Jan 2023 08:53:07 -0500 Subject: [PATCH 175/213] Document units of 75 scattered variables Added or amended comments to document the units of 75 variables in 23 files in the src/core, src/initialization, src/ice_shelf and src/user directories that had been overlooked when the other variables in these files had their units documented. Only comments are changed, and all answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 12 ++++----- src/core/MOM_checksum_packages.F90 | 6 ++--- src/core/MOM_density_integrals.F90 | 6 ++--- src/core/MOM_porous_barriers.F90 | 2 +- src/ice_shelf/MOM_marine_ice.F90 | 2 +- src/ice_shelf/user_shelf_init.F90 | 4 ++- src/initialization/MOM_grid_initialize.F90 | 16 +++++------ .../MOM_state_initialization.F90 | 6 ++--- src/user/MOM_controlled_forcing.F90 | 6 ++--- src/user/MOM_wave_interface.F90 | 15 ++++++----- src/user/Phillips_initialization.F90 | 27 +++++++++++-------- src/user/SCM_CVMix_tests.F90 | 4 +-- src/user/benchmark_initialization.F90 | 8 +++--- src/user/circle_obcs_initialization.F90 | 7 ++++- src/user/dense_water_initialization.F90 | 4 +-- src/user/dumbbell_surface_forcing.F90 | 2 +- src/user/dyed_channel_initialization.F90 | 4 +-- src/user/dyed_obcs_initialization.F90 | 2 +- src/user/external_gwave_initialization.F90 | 3 ++- src/user/lock_exchange_initialization.F90 | 4 +-- src/user/shelfwave_initialization.F90 | 2 +- src/user/user_change_diffusivity.F90 | 4 +-- src/user/user_revise_forcing.F90 | 2 +- 23 files changed, 82 insertions(+), 66 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 3ee203210c..056b171ba8 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -189,12 +189,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: CAuS ! - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: CAvS ! - real :: fv1, fv2, fv3, fv4 ! (f+rv)*v [L T-2 ~> m s-2]. - real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u [L T-2 ~> m s-2]. - real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis - real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: CAuS ! Stokes contribution to CAu [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: CAvS ! Stokes contribution to CAv [L T-2 ~> m s-2] + real :: fv1, fv2, fv3, fv4 ! (f+rv)*v at the 4 points surrounding a u points[L T-2 ~> m s-2] + real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u at the 4 points surrounding a v point [L T-2 ~> m s-2] + real :: max_fv, max_fu ! The maximum of the neighboring Coriolis accelerations [L T-2 ~> m s-2] + real :: min_fv, min_fu ! The minimum of the neighboring Coriolis accelerations [L T-2 ~> m s-2] real, parameter :: C1_12 = 1.0 / 12.0 ! C1_12 = 1/12 [nondim] real, parameter :: C1_24 = 1.0 / 24.0 ! C1_24 = 1/24 [nondim] diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 871de51632..80630084b9 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -29,9 +29,9 @@ module MOM_checksum_packages !> A type for storing statistica about a variable type :: stats ; private - real :: minimum = 1.E34 !< The minimum value - real :: maximum = -1.E34 !< The maximum value - real :: average = 0. !< The average value + real :: minimum = 1.E34 !< The minimum value [degC] or [ppt] or other units + real :: maximum = -1.E34 !< The maximum value [degC] or [ppt] or other units + real :: average = 0. !< The average value [degC] or [ppt] or other units end type stats contains diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 6cffea5c75..e1fb3d3278 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -143,7 +143,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3] real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3] - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] real :: GxRho ! The product of the gravitational acceleration and reference density [R L2 Z-1 T-2 ~> Pa m-1] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: dz ! The layer thickness [Z ~> m] @@ -784,7 +784,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: w_left, w_right ! Left and right weights [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] real :: GxRho ! The gravitational acceleration times density [R L2 Z-1 T-2 ~> kg m-2 s-2] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: dz ! Layer thicknesses at tracer points [Z ~> m] @@ -1175,7 +1175,7 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2] logical :: do_massWeight ! Indicates whether to do mass weighting. - real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index c1eb749467..4e812b65d7 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -29,7 +29,7 @@ module MOM_porous_barriers type(diag_ctrl), pointer :: & diag => Null() !< A structure to regulate diagnostic output timing logical :: debug !< If true, write verbose checksums for debugging purposes. - real :: mask_depth !< The depth shallower than which porous barrier is not applied. + real :: mask_depth !< The depth shallower than which porous barrier is not applied [Z ~> m] integer :: eta_interp !< An integer indicating how the interface heights at the velocity !! points are calculated. Valid values are given by the parameters !! defined below: MAX, MIN, ARITHMETIC and HARMONIC. diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 2a1b6d799b..8635eb71b5 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -28,7 +28,7 @@ module MOM_marine_ice type, public :: marine_ice_CS ; private real :: kv_iceberg !< The viscosity of the icebergs [L4 Z-2 T-1 ~> m2 s-1] (for ice rigidity) real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy - !! so that fluxes below are set to zero. (0.5 is a + !! so that fluxes below are set to zero [nondim]. (0.5 is a !! good value to use.) Not applied for negative values. real :: latent_heat_fusion !< Latent heat of fusion [Q ~> J kg-1] real :: density_iceberg !< A typical density of icebergs [R ~> kg m-3] (for ice rigidity) diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index c384ef7cee..4d1f263ca8 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -131,7 +131,9 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C logical, intent(in) :: new_sim !< If true, this the start of a new run. - real :: c1, edge_pos, slope_pos + real :: c1 ! The inverse of the range over which the shelf slopes [km-1] + real :: edge_pos ! The time-evolving position the ice shelf edge [km] + real :: slope_pos ! The time-evolving position of the start of the ice shelf slope [km] integer :: i, j edge_pos = CS%pos_shelf_edge_0 + CS%shelf_speed*(time_type_to_real(Time) / 86400.0) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index e622b11805..8bea8fe6e9 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -365,7 +365,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) ! Axis labels [degrees_E] or [km] or [m] real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -922,7 +922,7 @@ end function dL !! function fn takes the value fnval, also returning in ittmax the number of iterations of !! Newton's method that were used to polish the root. function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) - real :: find_root !< The value of y where fn(y) = fnval that will be returned + real :: find_root !< The value of y where fn(y) = fnval that will be returned [radians] real, external :: fn !< The external function whose root is being sought [gridpoints] real, external :: dy_df !< The inverse of the derivative of that function [radian gridpoint-1] type(GPS), intent(in) :: GP !< A structure of grid parameters @@ -1128,12 +1128,12 @@ end function Int_dj_dy !> Extrapolates missing metric data into all the halo regions. subroutine extrapolate_metric(var, jh, missing) - real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos [A] + real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos [abitrary] integer, intent(in) :: jh !< The size of the halos to be filled - real, optional, intent(in) :: missing !< The missing data fill value, 0 by default [A] + real, optional, intent(in) :: missing !< The missing data fill value, 0 by default [abitrary] ! Local variables - real :: badval - integer :: i,j + real :: badval ! A bad data value [abitrary] + integer :: i, j badval = 0.0 ; if (present(missing)) badval = missing @@ -1162,8 +1162,8 @@ end subroutine extrapolate_metric !> This function implements Adcroft's rule for reciprocals, namely that !! Adcroft_Inv(x) = 1/x for |x|>0 or 0 for x=0. function Adcroft_reciprocal(val) result(I_val) - real, intent(in) :: val !< The value being inverted. - real :: I_val !< The Adcroft reciprocal of val. + real, intent(in) :: val !< The value being inverted [abitrary] + real :: I_val !< The Adcroft reciprocal of val [abitrary-1] I_val = 0.0 if (val /= 0.0) I_val = 1.0/val diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 1eec90f568..0e50ebb67f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -885,10 +885,10 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re !! parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units, usually + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface, + ! positive upward [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 24d370e920..5be01bece4 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -397,7 +397,7 @@ end subroutine apply_ctrl_forcing !> This function maps rval into an integer in the range from 1 to num_period. function periodic_int(rval, num_period) result (m) - real, intent(in) :: rval !< Input for mapping. + real, intent(in) :: rval !< Input for mapping [nondim] integer, intent(in) :: num_period !< Maximum output. integer :: m !< Return value. @@ -412,9 +412,9 @@ function periodic_int(rval, num_period) result (m) !> This function shifts rval by an integer multiple of num_period so that !! 0 <= val_out < num_period. function periodic_real(rval, num_period) result(val_out) - real, intent(in) :: rval !< Input to be shifted into valid range. + real, intent(in) :: rval !< Input to be shifted into valid range [nondim] integer, intent(in) :: num_period !< Maximum valid value. - real :: val_out !< Return value. + real :: val_out !< Return value [nondim] integer :: nshft if (rval < 0) then ; nshft = floor(abs(rval) / num_period) + 1 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f99ca27994..723c8a0595 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1676,8 +1676,10 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) pointer :: CS !< Surface wave related control structure. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The stokes induced Pressure anomaly, layer averaged - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The stokes induced Pressure anomaly at interfaces + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The Stokes induced pressure anomaly, + ! layer averaged [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The Stokes induced pressure anomaly + ! at interfaces [L2 T-2 ~> m2 s-2] real :: P_Stokes_l, P_Stokes_r ! Stokes-induced pressure anomaly over layer (left/right of point) [L2 T-2 ~> m2 s-2] real :: P_Stokes_l0, P_Stokes_r0 ! Stokes-induced pressure anomaly at interface ! (left/right of point) [L2 T-2 ~> m2 s-2] @@ -1690,11 +1692,12 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real :: zi_l(SZK_(G)+1), zi_r(SZK_(G)+1) ! The height of the edges of the cells (left/right of point) [Z ~> m]. real :: idz_l(SZK_(G)), idz_r(SZK_(G)) ! The inverse thickness of the cells (left/right of point) [Z-1 ~> m-1] real :: h_l, h_r ! The thickness of the cell (left/right of point) [Z ~> m]. - real :: dexp2kzL,dexp4kzL,dexp2kzR,dexp4kzR ! Analytical evaluation of multi-exponential decay contribution - ! to Stokes pressure anomalies. - real :: TwoK, FourK, iTwoK, iFourK ! Wavenumber multipliers/inverses + real :: dexp2kzL, dexp4kzL, dexp2kzR, dexp4kzR ! Analytical evaluation of multi-exponential decay + ! contribution to Stokes pressure anomalies [nondim]. + real :: TwoK, FourK ! Wavenumbers multiplied by a factor [Z-1 ~> m-1] + real :: iTwoK, iFourK ! Inverses of wavenumbers [Z ~> m] - integer :: i,j,k,l + integer :: i, j, k, l !--------------------------------------------------------------- ! Compute the Stokes contribution to the pressure gradient force diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 06b3ed43d6..62b55bb0a1 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -233,16 +233,16 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field [H ~> m or kg m-2]. ! Local variables - real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces. + real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces [Z ~> m] real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. - real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables. + real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables [various] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m]. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate [T-1 ~> s-1]. real :: damp_rate ! The inverse zonal-mean damping rate [T-1 ~> s-1]. - real :: jet_width ! The width of the zonal mean jet, in km. + real :: jet_width ! The width of the zonal mean jet [km]. real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m]. - real :: y_2 ! The y-position relative to the channel center, in km. + real :: y_2 ! The y-position relative to the channel center [km]. real :: half_strat ! The fractional depth where the straficiation is centered [nondim]. real :: half_depth ! The depth where the stratification is centered [Z ~> m]. real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] @@ -309,8 +309,8 @@ end subroutine Phillips_initialize_sponges !> sech calculates the hyperbolic secant. function sech(x) - real, intent(in) :: x !< Input value. - real :: sech !< Result. + real, intent(in) :: x !< Input value [nondim]. + real :: sech !< Result [nondim]. ! This is here to prevent overflows or underflows. if (abs(x) > 228.) then @@ -330,9 +330,14 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: PI, Htop, Wtop, Ltop, offset, dist - real :: x1, x2, x3, x4, y1, y2 - integer :: i,j,is,ie,js,je + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: Htop ! The maximum height of the topography above max_depth [Z ~> m] + real :: Wtop ! meridional width of topographic features [km] + real :: Ltop ! zonal width of topographic features [km] + real :: offset ! meridional offset from the center of topographic features [km] + real :: dist ! zonal width of topographic features [km] + real :: x1, x2, x3, x4, y1, y2 ! Various positions in the domain [km] + integer :: i, j, is, ie, js, je character(len=40) :: mdl = "Phillips_initialize_topography" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -349,8 +354,8 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) dist = 0.333*G%len_lon ! distance between drake and mount ! should be longer than Ltop/2 - y1=G%south_lat+0.5*G%len_lat+offset-0.5*Wtop; y2=y1+Wtop - x1=G%west_lon+0.1*G%len_lon; x2=x1+Ltop; x3=x1+dist; x4=x3+3.0/2.0*Ltop + y1 = G%south_lat+0.5*G%len_lat+offset-0.5*Wtop ; y2 = y1+Wtop + x1 = G%west_lon+0.1*G%len_lon ; x2 = x1+Ltop ; x3 = x1+dist ; x4 = x3+3.0/2.0*Ltop do j=js,je ; do i=is,ie D(i,j)=0.0 diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index f681231694..8df8f90e3d 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -197,7 +197,7 @@ subroutine SCM_CVMix_tests_wind_forcing(sfc_state, forces, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: mag_tau + real :: mag_tau ! The magnitude of the wind stress [R L Z T-2 ~> Pa] ! Bounds for loops and memory allocation is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -231,7 +231,7 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(sfc_state, fluxes, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] PI = 4.0*atan(1.0) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index a9344a6a30..3920b52729 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -41,7 +41,7 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) ! Local variables real :: min_depth ! The minimum basin depth [Z ~> m] - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] real :: x ! Longitude relative to the domain edge, normalized by its extent [nondim] real :: y ! Latitude relative to the domain edge, normalized by its extent [nondim] @@ -113,7 +113,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e drho_dT, & ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. drho_dS ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa]. - real :: a_exp ! The fraction of the overall stratification that is exponential. + real :: a_exp ! The fraction of the overall stratification that is exponential [nondim] real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature [nondim]. @@ -121,7 +121,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! interface temperature for a given z [nondim] real :: derr_dz ! The derivative of the normalized error between the profile's ! temperature and the interface temperature with z [Z-1 ~> m-1] - real :: pi ! 3.1415926... calculated as 4*atan(1) + real :: pi ! 3.1415926... calculated as 4*atan(1) [nondim] real :: z ! A work variable for the interface position [Z ~> m] ! This include declares and sets the variable "version". # include "version_variable.h" @@ -246,7 +246,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1] real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3] - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: SST ! The initial sea surface temperature [C ~> degC] character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 07fc539979..63c5c8a0d4 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -44,7 +44,12 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. real :: IC_amp ! The amplitude of the initial height displacement [H ~> m or kg m-2]. - real :: diskrad, rad, lonC, latC, xOffset + real :: diskrad ! Radius of the elevated disk [km] or [degrees] or [m] + real :: rad ! Distance from the center of the elevated disk [km] or [degrees] or [m] + real :: lonC ! The x-position of a point [km] or [degrees] or [m] + real :: latC ! The y-position of a point [km] or [degrees] or [m] + real :: xOffset ! The x-offset of the elevated disc center relative to the domain + ! center [km] or [degrees] or [m] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 5e0cb65007..81aa4c2b3b 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -35,9 +35,9 @@ module dense_water_initialization subroutine dense_water_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables real, dimension(5) :: domain_params ! nondimensional widths of all domain sections [nondim] diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 0b8f59a6e8..4ac5ab3bf9 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -34,7 +34,7 @@ module dumbbell_surface_forcing !! to the reservoirs real :: slp_period !< Period of sinusoidal pressure wave [days] real, dimension(:,:), allocatable :: & - forcing_mask !< A mask regulating where forcing occurs + forcing_mask !< A mask regulating where forcing occurs [nondim] real, dimension(:,:), allocatable :: & S_restore !< The surface salinity field toward which to restore [S ~> ppt]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 411ab6ef98..aed7142fad 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -94,7 +94,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) character(len=40) :: mdl = "dyed_channel_set_OBC_tracer_data" ! This subroutine's name. character(len=80) :: name, longname integer :: m, n - real :: dye + real :: dye ! Inflow dye concentrations [arbitrary] type(tracer_type), pointer :: tr_ptr => NULL() if (.not.associated(OBC)) call MOM_error(FATAL, 'dyed_channel_initialization.F90: '// & @@ -142,7 +142,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, GV, US, Time) type(time_type), intent(in) :: Time !< model time. ! Local variables real :: flow ! The OBC velocity [L T-1 ~> m s-1] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] real :: time_sec ! The elapsed time since the start of the calendar [T ~> s] integer :: i, j, k, l, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index c5efef4905..6248efab2f 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -41,7 +41,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) character(len=80) :: name, longname integer :: is, ie, js, je, isd, ied, jsd, jed, m, n, nz integer :: IsdB, IedB, JsdB, JedB - real :: dye + real :: dye ! Inflow dye concentration [arbitrary] type(tracer_type), pointer :: tr_ptr => NULL() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 554440dbcb..63cc89342a 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -44,7 +44,8 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz - real :: PI, Xnondim + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: Xnondim ! A normalized x position [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index a3418e6482..3b41237c36 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -36,8 +36,8 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward [Z ~> m]. - real :: front_displacement ! Vertical displacement acrodd front - real :: thermocline_thickness ! Thickness of stratified region + real :: front_displacement ! Vertical displacement across front [Z ~> m] + real :: thermocline_thickness ! Thickness of stratified region [Z ~> m] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "lock_exchange_initialize_thickness" ! This subroutine's name. diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 5d7f1b7e97..df46a142f1 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -138,7 +138,7 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the shelfwave example. diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index f125da0a25..c12d34a721 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -151,7 +151,7 @@ end subroutine user_change_diff !> This subroutine checks whether the 4 values of range are in ascending order. function range_OK(range) result(OK) - real, dimension(4), intent(in) :: range !< Four values to check. + real, dimension(4), intent(in) :: range !< Four values to check [arbitrary] logical :: OK !< Return value. OK = ((range(1) <= range(2)) .and. (range(2) <= range(3)) .and. & @@ -169,7 +169,7 @@ function val_weights(val, range) result(ans) real, dimension(4), intent(in) :: range !< Range over which the answer is non-zero [arbitrary units]. real :: ans !< Return value [nondim]. ! Local variables - real :: x ! A nondimensional number between 0 and 1. + real :: x ! A nondimensional number between 0 and 1 [nondim]. ans = 0.0 if ((val > range(1)) .and. (val < range(4))) then diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index eb9694a091..ce767d7479 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -21,7 +21,7 @@ module user_revise_forcing !> Control structure for user_revise_forcing type, public :: user_revise_forcing_CS ; private - real :: cdrag !< The quadratic bottom drag coefficient. + real :: cdrag !< The quadratic bottom drag coefficient [nondim] end type user_revise_forcing_CS contains From cab1e848a99289cbd5e860c5d6406f3442a2b38b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 29 Jan 2023 13:42:50 -0500 Subject: [PATCH 176/213] Document units of about 250 EOS variables Added or amended comments to document the units of about 250 variables in 6 files in the src/equation_of_state directories. Also revised comments to make it clear that the MOM6 code for the UNESCO equation of state is based on the Jackett and MacDougall (1995) refit to the UNESCO equation of state (which uses potential temperature as a state variable) as opposed to the original UNESCO equation of state, as documented in an appendix to Gill (1982) (which uses in-situ temperature as a state variable). Also corrected a handful of spelling errors in comments. Only comments are changed, and all answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 8 +- src/equation_of_state/MOM_EOS_NEMO.F90 | 29 ++-- src/equation_of_state/MOM_EOS_TEOS10.F90 | 118 +++++++++------ src/equation_of_state/MOM_EOS_UNESCO.F90 | 184 +++++++++++++++-------- src/equation_of_state/MOM_EOS_Wright.F90 | 173 ++++++++++++++------- src/equation_of_state/MOM_EOS_linear.F90 | 22 +-- src/equation_of_state/MOM_TFreeze.F90 | 44 +++--- 7 files changed, 370 insertions(+), 208 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 27484aa536..12b87ebc64 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -428,7 +428,7 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: T2_scale ! A factor to convert temperature variance to units of degC2 [degC2 C-2 ~> 1] real :: S2_scale ! A factor to convert salinity variance to units of ppt2 [ppt2 S-2 ~> 1] - real :: TS_scale ! A factor to convert temperture-salinity covariance to units of + real :: TS_scale ! A factor to convert temperature-salinity covariance to units of ! degC ppt [degC ppt C-1 S-1 ~> 1] real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] @@ -1023,7 +1023,7 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d end subroutine calculate_density_second_derivs_1d -!> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. +!> Calls the appropriate subroutine to calculate density second derivatives for scalar inputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & drho_dS_dP, drho_dT_dP, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] @@ -1266,7 +1266,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables - ! These arrays use the same units as their counterparts in calcluate_compress_1d. + ! These arrays use the same units as their counterparts in calculate_compress_1d. real, dimension(1) :: pa ! Pressure in a size-1 1d array [R L2 T-2 ~> Pa] real, dimension(1) :: Ta ! Temperature in a size-1 1d array [C ~> degC] real, dimension(1) :: Sa ! Salinity in a size-1 1d array [S ~> ppt] @@ -1734,7 +1734,7 @@ subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) ! Local variables real, dimension(size(S)) :: Sa ! Salinity converted to [ppt] - real :: S_scale ! A factor to convert practical salnity from ppt to the desired units [S ppt-1 ~> 1] + real :: S_scale ! A factor to convert practical salinity from ppt to the desired units [S ppt-1 ~> 1] integer :: i, is, ie if (present(dom)) then diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index 476fda6b70..de4a715489 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -35,7 +35,7 @@ module MOM_EOS_NEMO module procedure calculate_density_derivs_scalar_nemo, calculate_density_derivs_array_nemo end interface calculate_density_derivs_nemo -real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar +real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar [Pa dbar-1] !>@{ Parameters in the NEMO equation of state real, parameter :: rdeltaS = 32. real, parameter :: r1_S0 = 0.875/35.16504 @@ -184,8 +184,10 @@ subroutine calculate_density_scalar_nemo(T, S, pressure, rho, rho_ref) real, intent(out) :: rho !< In situ density [kg m-3]. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] T0(1) = T S0(1) = S @@ -345,8 +347,13 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds real, intent(out) :: drho_dS !< The partial derivative of density with salinity, !! in [kg m-3 ppt-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: drdt0, drds0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! A 1-d array with a copy of the derivative of density + ! with potential temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! A 1-d array with a copy of the derivative of density + ! with salinity [kg m-3 ppt-1] T0(1) = T S0(1) = S @@ -358,12 +365,12 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds end subroutine calculate_density_derivs_scalar_nemo !> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility -!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity -!! (sal in g/kg), conservative temperature (T [degC]), and pressure [Pa], using the expressions +!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), +!! conservative temperature (T [degC]), and pressure [Pa], using the expressions !! derived for use with NEMO. subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. - real, intent(in), dimension(:) :: S !< Absolute salinity [g/kg]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure @@ -373,7 +380,9 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs,zt,zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j call calculate_density_array_nemo(T, S, pressure, rho, start, npts) @@ -384,7 +393,7 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar call gsw_rho_first_derivatives(zs,zt,zp, drho_dp=drho_dp(j)) enddo diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index bbe9982b6f..4c7483c068 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -48,14 +48,13 @@ module MOM_EOS_TEOS10 module procedure calculate_density_second_derivs_scalar_teos10, calculate_density_second_derivs_array_teos10 end interface calculate_density_second_derivs_teos10 -real, parameter :: Pa2db = 1.e-4 !< The conversion factor from Pa to dbar. +real, parameter :: Pa2db = 1.e-4 !< The conversion factor from Pa to dbar [dbar Pa-1] contains -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure [Pa]. It uses the expression from the -!! TEOS10 website. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from absolute salinity (S [g kg-1]), conservative temperature (T [degC]), +!! and pressure [Pa]. It uses the expression from the TEOS10 website. subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Conservative temperature [degC]. real, intent(in) :: S !< Absolute salinity [g kg-1]. @@ -64,8 +63,10 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] T0(1) = T S0(1) = S @@ -76,9 +77,9 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_teos10 -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure [Pa]. It uses the expression from the +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from absolute salinity (S [g kg-1]), conservative temperature (T [degC]), +!! and pressure [Pa]. It uses the expression from the !! TEOS10 website. subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. @@ -90,13 +91,15 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? @@ -120,7 +123,10 @@ subroutine calculate_spec_vol_scalar_teos10(T, S, pressure, specvol, spv_ref) real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0, spv0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -134,8 +140,7 @@ end subroutine calculate_spec_vol_scalar_teos10 !! and pressure [Pa], using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, spv_ref) - real, dimension(:), intent(in) :: T !< Conservative temperature relative to the surface - !! [degC]. + real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. real, dimension(:), intent(in) :: S !< salinity [g kg-1]. real, dimension(:), intent(in) :: pressure !< pressure [Pa]. real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. @@ -144,13 +149,15 @@ subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar if (S(j) < -1.0e-10) then @@ -177,15 +184,17 @@ subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_d integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? drho_dT(j) = 0.0 ; drho_dS(j) = 0.0 else call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS(j), drho_dct=drho_dT(j)) @@ -206,10 +215,13 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_ !! [kg m-3 (g/kg)-1]. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] + !Conversions zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp + zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar if (S < -1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) @@ -229,15 +241,17 @@ subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? dSV_dT(j) = 0.0 ; dSV_dS(j) = 0.0 else call gsw_specvol_first_derivatives(zs,zt,zp, v_sa=dSV_dS(j), v_ct=dSV_dT(j)) @@ -252,18 +266,25 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS real, intent(in) :: T !< Conservative temperature [degC] real, intent(in) :: S !< Absolute Salinity [g kg-1] real, intent(in) :: pressure !< pressure [Pa]. - real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T - real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect + !! to S [kg m-3 (g/kg)-2] + real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respect + !! to T [kg m-3 (g/kg)-1 degC-1] + real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect + !! to pressure [kg m-3 (g/kg)-1 Pa-1] = [s2 m-2 (g/kg)-1] + real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] !Conversions zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp + zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar if (S < -1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_second_derivatives(zs, zt, zp, rho_sa_sa=drho_dS_dS, rho_sa_ct=drho_dS_dT, & @@ -277,24 +298,31 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_ real, dimension(:), intent(in) :: T !< Conservative temperature [degC] real, dimension(:), intent(in) :: S !< Absolute Salinity [g kg-1] real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T - real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect + !! to S [kg m-3 (g/kg)-2] + real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with respect + !! to T [kg m-3 (g/kg)-1 degC-1] + real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect + !! to pressure [kg m-3 (g/kg)-1 Pa-1] = [s2 m-2 (g/kg)-1] + real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? drho_dS_dS(j) = 0.0 ; drho_dS_dT(j) = 0.0 ; drho_dT_dT(j) = 0.0 drho_dS_dP(j) = 0.0 ; drho_dT_dP(j) = 0.0 else @@ -307,7 +335,7 @@ end subroutine calculate_density_second_derivs_array_teos10 !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) -!! (drho_dp [s2 m-2]) from absolute salinity (sal in g/kg), +!! (drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), !! conservative temperature (T [degC]), and pressure [Pa]. It uses the !! subroutines from TEOS10 website subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) @@ -322,15 +350,17 @@ subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs,zt,zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? rho(j) = 1000.0 ; drho_dp(j) = 0.0 else rho(j) = gsw_rho(zs,zt,zp) diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index a296cfc382..59ebb92c7a 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -17,45 +17,80 @@ module MOM_EOS_UNESCO public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to -!! a reference density, from salinity [PSU], potential temperature [degC], and pressure [Pa], -!! using the UNESCO (1981) equation of state. +!! a reference density, from salinity [PSU], potential temperature [degC] and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). interface calculate_density_UNESCO module procedure calculate_density_scalar_UNESCO, calculate_density_array_UNESCO end interface calculate_density_UNESCO !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from salinity [PSU], potential temperature [degC], and -!! pressure [Pa], using the UNESCO (1981) equation of state. +!! pressure [Pa], using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). interface calculate_spec_vol_UNESCO module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO end interface calculate_spec_vol_UNESCO -!>@{ Parameters in the UNESCO equation of state -! The following constants are used to calculate rho0. The notation -! is Rab for the contribution to rho0 from T^aS^b. -real, parameter :: R00 = 999.842594, R10 = 6.793952e-2, R20 = -9.095290e-3, & - R30 = 1.001685e-4, R40 = -1.120083e-6, R50 = 6.536332e-9, R01 = 0.824493, & - R11 = -4.0899e-3, R21 = 7.6438e-5, R31 = -8.2467e-7, R41 = 5.3875e-9, & - R032 = -5.72466e-3, R132 = 1.0227e-4, R232 = -1.6546e-6, R02 = 4.8314e-4 - -! The following constants are used to calculate the secant bulk mod- -! ulus. The notation here is Sab for terms proportional to T^a*S^b, -! Spab for terms proportional to p*T^a*S^b, and SPab for terms +!>@{ Parameters in the UNESCO equation of state, as published in appendix A3 of Gill, 1982. +! The following constants are used to calculate rho0, the density of seawater at 1 +! atmosphere pressure. The notation is Rab for the contribution to rho0 from T^a*S^b. +real, parameter :: R00 = 999.842594 ! A coefficient in the fit for rho0 [kg m-3] +real, parameter :: R10 = 6.793952e-2 ! A coefficient in the fit for rho0 [kg m-3 degC-1] +real, parameter :: R20 = -9.095290e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-2] +real, parameter :: R30 = 1.001685e-4 ! A coefficient in the fit for rho0 [kg m-3 degC-3] +real, parameter :: R40 = -1.120083e-6 ! A coefficient in the fit for rho0 [kg m-3 degC-4] +real, parameter :: R50 = 6.536332e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-5] +real, parameter :: R01 = 0.824493 ! A coefficient in the fit for rho0 [kg m-3 PSU-1] +real, parameter :: R11 = -4.0899e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-1 PSU-1] +real, parameter :: R21 = 7.6438e-5 ! A coefficient in the fit for rho0 [kg m-3 degC-2 PSU-1] +real, parameter :: R31 = -8.2467e-7 ! A coefficient in the fit for rho0 [kg m-3 degC-3 PSU-1] +real, parameter :: R41 = 5.3875e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-4 PSU-1] +real, parameter :: R032 = -5.72466e-3 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] +real, parameter :: R132 = 1.0227e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] +real, parameter :: R232 = -1.6546e-6 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] +real, parameter :: R02 = 4.8314e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-2] + +! The following constants are used to calculate the secant bulk modulus. +! The notation here is Sab for terms proportional to T^a*S^b, +! Spab for terms proportional to p*T^a*S^b, and SP0ab for terms ! proportional to p^2*T^a*S^b. -real, parameter :: S00 = 1.965933e4, S10 = 1.444304e2, S20 = -1.706103, & - S30 = 9.648704e-3, S40 = -4.190253e-5, S01 = 52.84855, S11 = -3.101089e-1, & - S21 = 6.283263e-3, S31 = -5.084188e-5, S032 = 3.886640e-1, S132 = 9.085835e-3, & - S232 = -4.619924e-4, Sp00 = 3.186519, Sp10 = 2.212276e-2, Sp20 = -2.984642e-4, & - Sp30 = 1.956415e-6, Sp01 = 6.704388e-3, Sp11 = -1.847318e-4, Sp21 = 2.059331e-7, & - Sp032 = 1.480266e-4, SP000 = 2.102898e-4, SP010 = -1.202016e-5, SP020 = 1.394680e-7, & - SP001 = -2.040237e-6, SP011 = 6.128773e-8, SP021 = 6.207323e-10 +! Note that these values differ from those in Appendix A of Gill (1982) because the expressions +! from Jackett and MacDougall (1995) use potential temperature, rather than in situ temperature. +real, parameter :: S00 = 1.965933e4 ! A coefficient in the secant bulk modulus fit [bar] +real, parameter :: S10 = 1.444304e2 ! A coefficient in the secant bulk modulus fit [bar degC-1] +real, parameter :: S20 = -1.706103 ! A coefficient in the secant bulk modulus fit [bar degC-2] +real, parameter :: S30 = 9.648704e-3 ! A coefficient in the secant bulk modulus fit [bar degC-3] +real, parameter :: S40 = -4.190253e-5 ! A coefficient in the secant bulk modulus fit [bar degC-4] +real, parameter :: S01 = 52.84855 ! A coefficient in the secant bulk modulus fit [bar PSU-1] +real, parameter :: S11 = -3.101089e-1 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-1] +real, parameter :: S21 = 6.283263e-3 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-1] +real, parameter :: S31 = -5.084188e-5 ! A coefficient in the secant bulk modulus fit [bar degC-3 PSU-1] +real, parameter :: S032 = 3.886640e-1 ! A coefficient in the secant bulk modulus fit [bar PSU-3/2] +real, parameter :: S132 = 9.085835e-3 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-3/2] +real, parameter :: S232 = -4.619924e-4 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-3/2] + +real, parameter :: Sp00 = 3.186519 ! A coefficient in the secant bulk modulus fit [nondim] +real, parameter :: Sp10 = 2.212276e-2 ! A coefficient in the secant bulk modulus fit [degC-1] +real, parameter :: Sp20 = -2.984642e-4 ! A coefficient in the secant bulk modulus fit [degC-2] +real, parameter :: Sp30 = 1.956415e-6 ! A coefficient in the secant bulk modulus fit [degC-3] +real, parameter :: Sp01 = 6.704388e-3 ! A coefficient in the secant bulk modulus fit [PSU-1] +real, parameter :: Sp11 = -1.847318e-4 ! A coefficient in the secant bulk modulus fit [degC-1 PSU-1] +real, parameter :: Sp21 = 2.059331e-7 ! A coefficient in the secant bulk modulus fit [degC-2 PSU-1] +real, parameter :: Sp032 = 1.480266e-4 ! A coefficient in the secant bulk modulus fit [PSU-3/2] + +real, parameter :: SP000 = 2.102898e-4 ! A coefficient in the secant bulk modulus fit [bar-1] +real, parameter :: SP010 = -1.202016e-5 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1] +real, parameter :: SP020 = 1.394680e-7 ! A coefficient in the secant bulk modulus fit [bar-1 degC-2] +real, parameter :: SP001 = -2.040237e-6 ! A coefficient in the secant bulk modulus fit [bar-1 PSU-1] +real, parameter :: SP011 = 6.128773e-8 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-1] +real, parameter :: SP021 = 6.207323e-10 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-2] !>@} contains -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from salinity (S [PSU]), potential temperature (T [degC]), and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +!! If rho_ref is present, rho is an anomaly from rho_ref. subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface [degC]. real, intent(in) :: S !< Salinity [PSU]. @@ -64,8 +99,10 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the in situ density [kg m-3] T0(1) = T S0(1) = S @@ -76,9 +113,10 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_UNESCO -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from salinity (S [PSU]), potential temperature (T [degC]) and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +!! If rho_ref is present, rho is an anomaly from rho_ref. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. real, dimension(:), intent(in) :: S !< salinity [PSU]. @@ -89,8 +127,12 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: sig0 ! The anomaly of rho0 from R00 [kg m-3]. @@ -103,9 +145,9 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). @@ -130,9 +172,9 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ enddo end subroutine calculate_density_array_UNESCO -!> This subroutine computes the in situ specific volume of sea water (specvol in -!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ specific volume of sea water (specvol in [m3 kg-1]) +!! from salinity (S [PSU]), potential temperature (T [degC]) and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, intent(in) :: T !< potential temperature relative to the surface @@ -143,7 +185,10 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0, spv0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -151,9 +196,9 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) specvol = spv0(1) end subroutine calculate_spec_vol_scalar_UNESCO -!> This subroutine computes the in situ specific volume of sea water (specvol in -!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ specific volume of sea water (specvol in [m3 kg-1]) +!! from salinity (S [PSU]), potential temperature (T [degC]) and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface @@ -166,8 +211,12 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: ks ! The secant bulk modulus [bar]. @@ -180,9 +229,9 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). @@ -222,8 +271,13 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s12, s_local, s32, s2 ! Salinity to the 1/2 - 2nd powers [PSU^n]. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s12 ! The square root of salinity [PSU1/2] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: ks ! The secant bulk modulus [bar]. @@ -240,9 +294,9 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s12 = sqrt(s_local); s32 = s_local*s12 + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s12 = sqrt(s_local) ; s32 = s_local*s12 ! compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ) @@ -293,14 +347,20 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. - real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. - real :: rho0 ! Density at 1 bar pressure [kg m-3]. - real :: ks ! The secant bulk modulus [bar]. - real :: ks_0, ks_1, ks_2 - real :: dks_dp ! The derivative of the secant bulk modulus - ! with pressure, nondimensional. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. + real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. + real :: rho0 ! Density at 1 bar pressure [kg m-3]. + real :: ks ! The secant bulk modulus [bar]. + real :: ks_0 ! The secant bulk modulus at zero pressure [bar]. + real :: ks_1 ! The derivative of the secant bulk modulus with pressure at zero pressure [nondim]. + real :: ks_2 ! The second derivative of the secant bulk modulus with pressure at zero pressure [nondim]. + real :: dks_dp ! The derivative of the secant bulk modulus + ! with pressure [nondim] integer :: j do j=start,start+npts-1 @@ -309,9 +369,9 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index c2e50287b2..77e0d17ff3 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -27,15 +27,17 @@ module MOM_EOS_Wright !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to -!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure [Pa], -!! using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! a reference density, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_density_wright module procedure calculate_density_scalar_wright, calculate_density_array_wright end interface calculate_density_wright !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect -!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and -!! pressure [Pa], using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! to a reference specific volume, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_spec_vol_wright module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright end interface calculate_spec_vol_wright @@ -64,11 +66,25 @@ module MOM_EOS_Wright ! Following are the values for the reduced range formula. -real, parameter :: a0 = 7.057924e-4, a1 = 3.480336e-7, a2 = -1.112733e-7 ! a0/a1 ~= 2028 ; a0/a2 ~= -6343 -real, parameter :: b0 = 5.790749e8, b1 = 3.516535e6, b2 = -4.002714e4 ! b0/b1 ~= 165 ; b0/b4 ~= 974 -real, parameter :: b3 = 2.084372e2, b4 = 5.944068e5, b5 = -9.643486e3 -real, parameter :: c0 = 1.704853e5, c1 = 7.904722e2, c2 = -7.984422 ! c0/c1 ~= 216 ; c0/c4 ~= -740 -real, parameter :: c3 = 5.140652e-2, c4 = -2.302158e2, c5 = -3.079464 + ! Note that a0/a1 ~= 2028 [degC] ; a0/a2 ~= -6343 [PSU] + ! b0/b1 ~= 165 [degC] ; b0/b4 ~= 974 [PSU] + ! c0/c1 ~= 216 [degC] ; c0/c4 ~= -740 [PSU] + ! and also that (as always) [Pa] = [kg m-1 s-2] +real, parameter :: a0 = 7.057924e-4 ! A parameter in the Wright alpha_0 fit [m3 kg-1] +real, parameter :: a1 = 3.480336e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 degC-1] +real, parameter :: a2 = -1.112733e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 PSU-1] +real, parameter :: b0 = 5.790749e8 ! A parameter in the Wright p_0 fit [Pa] +real, parameter :: b1 = 3.516535e6 ! A parameter in the Wright p_0 fit [Pa degC-1] +real, parameter :: b2 = -4.002714e4 ! A parameter in the Wright p_0 fit [Pa degC-2] +real, parameter :: b3 = 2.084372e2 ! A parameter in the Wright p_0 fit [Pa degC-3] +real, parameter :: b4 = 5.944068e5 ! A parameter in the Wright p_0 fit [Pa PSU-1] +real, parameter :: b5 = -9.643486e3 ! A parameter in the Wright p_0 fit [Pa degC-1 PSU-1] +real, parameter :: c0 = 1.704853e5 ! A parameter in the Wright lambda fit [m2 s-2] +real, parameter :: c1 = 7.904722e2 ! A parameter in the Wright lambda fit [m2 s-2 degC-1] +real, parameter :: c2 = -7.984422 ! A parameter in the Wright lambda fit [m2 s-2 degC-2] +real, parameter :: c3 = 5.140652e-2 ! A parameter in the Wright lambda fit [m2 s-2 degC-3] +real, parameter :: c4 = -2.302158e2 ! A parameter in the Wright lambda fit [m2 s-2 PSU-1] +real, parameter :: c5 = -3.079464 ! A parameter in the Wright lambda fit [m2 s-2 degC-1 PSU-1] !>@} contains @@ -86,13 +102,16 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) ! *====================================================================* ! * This subroutine computes the in situ density of sea water (rho in * -! * [kg m-3]) from salinity (S [PSU]), potential temperature * -! * (T [degC]), and pressure [Pa]. It uses the expression from * +! * [kg m-3]) from salinity (S [PSU]), potential temperature * +! * (T [degC]), and pressure [Pa]. It uses the expression from * ! * Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. * ! * Coded by R. Hallberg, 7/00 * ! *====================================================================* - real, dimension(1) :: T0, S0, pressure0, rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] T0(1) = T S0(1) = S @@ -118,8 +137,13 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ ! Original coded by R. Hallberg, 7/00, anomaly coded in 3/18. ! Local variables - real :: al0, p0, lambda - real :: al_TS, p_TSp, lam_TS, pa_000 + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: al_TS ! The contributions of temperature and salinity to al0 [m3 kg-1] + real :: p_TSp ! A combination of the pressure and the temperature and salinity contributions to p0 [Pa] + real :: lam_TS ! The contributions of temperature and salinity to lambda [m2 s-2] + real :: pa_000 ! A corrected offset to the pressure, including contributions from rho_ref [Pa] integer :: j if (present(rho_ref)) pa_000 = (b0*(1.0 - a0*rho_ref) - rho_ref*c0) @@ -155,7 +179,10 @@ subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0, spv0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -170,7 +197,7 @@ end subroutine calculate_spec_vol_scalar_wright !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the - !! surface [degC]. + !! surface [degC]. real, dimension(:), intent(in) :: S !< salinity [PSU]. real, dimension(:), intent(in) :: pressure !< pressure [Pa]. real, dimension(:), intent(inout) :: specvol !< in situ specific volume [m3 kg-1]. @@ -179,7 +206,9 @@ subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: al0, p0, lambda + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] integer :: j do j=start,start+npts-1 @@ -209,7 +238,10 @@ subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_d integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: al0, p0, lambda, I_denom2 + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom2 ! The inverse of the square of the denominator of density in the Wright EOS [s4 m-4] integer :: j do j=start,start+npts-1 @@ -241,8 +273,11 @@ subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_ !! in [kg m-3 PSU-1]. ! Local variables needed to promote the input/output scalars to 1-element arrays - real, dimension(1) :: T0, S0, P0 - real, dimension(1) :: drdt0, drds0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! The derivative of density with temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! The derivative of density with salinity [kg m-3 PSU-1] T0(1) = T S0(1) = S @@ -261,19 +296,28 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh real, dimension(:), intent(in ) :: P !< Pressure [Pa] real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect !! to S [kg m-3 PSU-2] - real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respcct + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect !! to T [kg m-3 PSU-1 degC-1] real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect !! to T [kg m-3 degC-2] real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect - !! to pressure [kg m-3 PSU-1 Pa-1] + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect - !! to pressure [kg m-3 degC-1 Pa-1] + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] integer, intent(in ) :: start !< Starting index in T,S,P integer, intent(in ) :: npts !< Number of points to loop over ! Local variables - real :: z0, z1, z2, z3, z4, z5, z6 ,z7, z8, z9, z10, z11, z2_2, z2_3 + real :: z0, z1 ! Local work variables [Pa] + real :: z2, z4 ! Local work variables [m2 s-2] + real :: z3, z5 ! Local work variables [Pa degC-1] + real :: z6, z8 ! Local work variables [m2 s-2 degC-1] + real :: z7 ! A local work variable [m2 s-2 PSU-1] + real :: z9 ! A local work variable [m3 kg-1] + real :: z10 ! A local work variable [Pa PSU-1] + real :: z11 ! A local work variable [Pa m2 s-2 PSU-1] = [kg m s-4 PSU-1] + real :: z2_2 ! A local work variable [m4 s-4] + real :: z2_3 ! A local work variable [m6 s-6] integer :: j ! Based on the above expression with common terms factored, there probably exists a more numerically stable ! and/or efficient expression @@ -313,17 +357,26 @@ subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, dr real, intent(in ) :: P !< pressure [Pa] real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect !! to S [kg m-3 PSU-2] - real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respcct + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect !! to T [kg m-3 PSU-1 degC-1] real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect !! to T [kg m-3 degC-2] real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect - !! to pressure [kg m-3 PSU-1 Pa-1] + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect - !! to pressure [kg m-3 degC-1 Pa-1] + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] ! Local variables - real, dimension(1) :: T0, S0, P0 - real, dimension(1) :: drdsds, drdsdt, drdtdt, drdsdp, drdtdp + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] T0(1) = T S0(1) = S @@ -346,12 +399,14 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with !! potential temperature [m3 kg-1 degC-1]. real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with - !! salinity [m3 kg-1 / Pa]. + !! salinity [m3 kg-1 PSU-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: p0, lambda, I_denom + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of specific volume in the Wright EOS [Pa-1] integer :: j do j=start,start+npts-1 @@ -370,11 +425,10 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_wright -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) -!! (drho_dp [s2 m-2]) from salinity (sal in psu), potential -!! temperature (T [degC]), and pressure [Pa]. It uses the expressions -!! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! and the compressibility (drho/dp = C_sound^-2) (drho_dp [s2 m-2]) from +!! salinity (sal [PSU]), potential temperature (T [degC]), and pressure [Pa]. +!! It uses the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! Coded by R. Hallberg, 1/01 subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. @@ -389,7 +443,10 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) ! Coded by R. Hallberg, 1/01 ! Local variables - real :: al0, p0, lambda, I_denom + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of density in the Wright EOS [s2 m-2] integer :: j do j=start,start+npts-1 @@ -421,7 +478,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted !! out to reduce the magnitude of each of the integrals. - !! (The pressure is calucated as p~=-z*rho_0*G_e.) + !! (The pressure is calculated as p~=-z*rho_0*G_e.) real, intent(in) :: rho_0 !< Density [R ~> kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. @@ -454,7 +511,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale !! temperature into degC [degC C-1 ~> 1] real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure - !! into ppt [ppt S-1 ~> 1]. + !! into PSU [PSU S-1 ~> 1]. real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! Local variables @@ -488,20 +545,20 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & ! pres_scale [R L2 T-2 Pa-1 ~> 1]. real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] - real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 ppt-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] - real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa ppt-1] - real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 ppt-1] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] - real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 ppt-1] - real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 ppt-1] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] logical :: do_massWeight ! Indicates whether to do mass weighting. - real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. - real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m ! These array bounds work for the indexing convention of the input arrays, but @@ -716,7 +773,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale !! temperature into degC [degC C-1 ~> 1] real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure - !! into ppt [ppt S-1 ~> 1]. + !! into PSU [PSU S-1 ~> 1]. ! Local variables real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [R-1 ~> m3 kg-1] @@ -743,27 +800,27 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] - real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 ppt-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] - real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa ppt-1] - real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 ppt-1] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] - real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 ppt-1] - real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 ppt-1] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] logical :: do_massWeight ! Indicates whether to do mass weighting. - real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. - real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, halo Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) ish = HI%isc-halo ; ieh = HI%iec+halo ; jsh = HI%jsc-halo ; jeh = HI%jec+halo - if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh); endif - if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh); endif + if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh) ; endif + if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh) ; endif al0_scale = 1.0 ; if (present(SV_scale)) al0_scale = SV_scale @@ -842,7 +899,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) @@ -883,7 +940,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1) p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1) lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1) diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 2b4f99adf0..07464861cb 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -21,16 +21,16 @@ module MOM_EOS_linear ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density, -!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) -!! and pressure [Pa]. +!> Compute the density of sea water (in [kg m-3]), or its anomaly from a reference density, +!! using a simple linear equation of state from salinity in practical salinity units ([PSU]), +!! potential temperature in degrees Celsius ([degC]) and pressure [Pa]. interface calculate_density_linear module procedure calculate_density_scalar_linear, calculate_density_array_linear end interface calculate_density_linear -!> Compute the specific volume of sea water (in m^3/kg), or its anomaly from a reference value, -!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) -!! and pressure [Pa]. +!> Compute the specific volume of sea water (in [m3 kg-1]), or its anomaly from a reference value, +!! using a simple linear equation of state from salinity in practical salinity units ([PSU]), +!! potential temperature in degrees Celsius ([degC]) and pressure [Pa]. interface calculate_spec_vol_linear module procedure calculate_spec_vol_scalar_linear, calculate_spec_vol_array_linear end interface calculate_spec_vol_linear @@ -75,7 +75,7 @@ subroutine calculate_density_scalar_linear(T, S, pressure, rho, & end subroutine calculate_density_scalar_linear !> This subroutine computes the density of sea water with a trivial -!! linear equation of state (in kg/m^3) from salinity (sal in psu), +!! linear equation of state (in [kg m-3]) from salinity (sal [PSU]), !! potential temperature (T [degC]), and pressure [Pa]. subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) @@ -561,8 +561,8 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) ish = HI%isc-halo ; ieh = HI%iec+halo ; jsh = HI%jsc-halo ; jeh = HI%jec+halo - if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh); endif - if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh); endif + if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh) ; endif + if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh) ; endif do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then @@ -612,7 +612,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j)) dRho_TS = dRho_dT*(wtT_L*T(i,j) + wtT_R*T(i+1,j)) + & @@ -657,7 +657,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1)) dRho_TS = dRho_dT*(wtT_L*T(i,j) + wtT_R*T(i,j+1)) + & diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index f0b22c8f4e..16a64c89ed 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -28,7 +28,7 @@ module MOM_TFreeze module procedure calculate_TFreeze_Millero_scalar, calculate_TFreeze_Millero_array end interface calculate_TFreeze_Millero -!> Compute the freezing point conservative temperature [degC] from absolute salinity [g/kg] +!> Compute the freezing point conservative temperature [degC] from absolute salinity [g kg-1] !! and pressure [Pa] using the TEOS10 package. interface calculate_TFreeze_teos10 module procedure calculate_TFreeze_teos10_scalar, calculate_TFreeze_teos10_array @@ -84,13 +84,15 @@ end subroutine calculate_TFreeze_linear_array !! expression for potential temperature (not in situ temperature), using a !! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pres !< Pressure [Pa]. - real, intent(out) :: T_Fr !< Freezing point potential temperature [degC]. + real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: pres !< Pressure [Pa] + real, intent(out) :: T_Fr !< Freezing point potential temperature [degC] ! Local variables - real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 - real, parameter :: dTFr_dp = -7.75e-8 + real, parameter :: cS1 = -0.0575 ! A term in the freezing point fit [degC PSU-1] + real, parameter :: cS3_2 = 1.710523e-3 ! A term in the freezing point fit [degC PSU-3/2] + real, parameter :: cS2 = -2.154996e-4 ! A term in the freezing point fit [degC PSU-2] + real, parameter :: dTFr_dp = -7.75e-8 ! Derivative of freezing point with pressure [degC Pa-1] T_Fr = S*(cS1 + (cS3_2 * sqrt(max(S,0.0)) + cS2 * S)) + dTFr_dp*pres @@ -110,8 +112,10 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 - real, parameter :: dTFr_dp = -7.75e-8 + real, parameter :: cS1 = -0.0575 ! A term in the freezing point fit [degC PSU-1] + real, parameter :: cS3_2 = 1.710523e-3 ! A term in the freezing point fit [degC PSU-3/2] + real, parameter :: cS2 = -2.154996e-4 ! A term in the freezing point fit [degC PSU-2] + real, parameter :: dTFr_dp = -7.75e-8 ! Derivative of freezing point with pressure [degC Pa-1] integer :: j do j=start,start+npts-1 @@ -121,17 +125,18 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) end subroutine calculate_TFreeze_Millero_array -!> This subroutine computes the freezing point conservative temperature -!! [degC] from absolute salinity [g/kg], and pressure [Pa] using the +!> This subroutine computes the freezing point conservative temperature [degC] +!! from absolute salinity [g kg-1], and pressure [Pa] using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) - real, intent(in) :: S !< Absolute salinity [g/kg]. + real, intent(in) :: S !< Absolute salinity [g kg-1]. real, intent(in) :: pres !< Pressure [Pa]. real, intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. ! Local variables - real, dimension(1) :: S0, pres0 - real, dimension(1) :: tfr0 + real, dimension(1) :: S0 ! Salinity at a point [g kg-1] + real, dimension(1) :: pres0 ! Pressure at a point [Pa] + real, dimension(1) :: tfr0 ! The freezing temperature [degC] S0(1) = S pres0(1) = pres @@ -141,22 +146,23 @@ subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_teos10_scalar -!> This subroutine computes the freezing point conservative temperature -!! [degC] from absolute salinity [g/kg], and pressure [Pa] using the +!> This subroutine computes the freezing point conservative temperature [degC] +!! from absolute salinity [g kg-1], and pressure [Pa] using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) - real, dimension(:), intent(in) :: S !< absolute salinity [g/kg]. + real, dimension(:), intent(in) :: S !< absolute salinity [g kg-1]. real, dimension(:), intent(in) :: pres !< pressure [Pa]. real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. ! Local variables - real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar. - real :: zs,zp + real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar [dbar Pa-1] + real :: zs ! Salinity at a point [g kg-1] + real :: zp ! Pressures in [dbar] integer :: j ! Assume sea-water contains no dissolved air. - real, parameter :: saturation_fraction = 0.0 + real, parameter :: saturation_fraction = 0.0 ! Air saturation fraction in seawater [nondim] do j=start,start+npts-1 !Conversions From 9412c9a89b469e4f43e9fbb29d81893a3b8be330 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 10 Feb 2023 13:50:56 -0500 Subject: [PATCH 177/213] Fixes build failure in gitlab pipeline - After a recent update to how the build environment is defined within MOM6-examples, the "no libraries" build test (unique to MOM6) is failing because the Makefile now no longer contains the environment. This commit overrides a CPP macro that points to the bash script that is needed. --- .gitlab/pipeline-ci-tool.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh index 8334bd3950..641e9f6053 100755 --- a/.gitlab/pipeline-ci-tool.sh +++ b/.gitlab/pipeline-ci-tool.sh @@ -135,7 +135,7 @@ nolibs-ocean-only-compile () { cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR mkdir -p build-ocean-only-nolibs-$1 cd build-ocean-only-nolibs-$1 - make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. -s + make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 sed -i '/FMS1\/.*\/test_/d' path_names ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names @@ -153,7 +153,7 @@ nolibs-ocean-ice-compile () { cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR mkdir -p build-ocean-ice-nolibs-$1 cd build-ocean-ice-nolibs-$1 - make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. -s + make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} sed -i '/FMS1\/.*\/test_/d' path_names ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names From 6ffbc907506931b8aa0e139498e2af59e7ee26af Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 28 Jan 2023 11:35:41 -0500 Subject: [PATCH 178/213] +Make output reproduce across layout if DEBUG=True This commit makes a set of changes so that the chksums output by the OM4_05 configuration with DEBUG = True reproduce between 252 and 256 PE runs (note that the solutions themselves already reproduced). This is includes adding a new optional omit_corners argument to the MOM_state_chksum and MOM_thermo_chksum routines, and revising the haloshift, omit_corners or symmetric arguments on 6 subroutine calls, to check more appropriate loop ranges. All answers are bitwise identical, but there is a new optional argument to three publicly visible debugging routines. --- src/core/MOM.F90 | 6 +-- src/core/MOM_checksum_packages.F90 | 50 ++++++++++++++-------- src/core/MOM_dynamics_split_RK2.F90 | 6 +-- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- 4 files changed, 39 insertions(+), 27 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index daa40ba052..00e748bdc1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1529,9 +1529,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) - call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) - call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, omit_corners=.true.) + call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, omit_corners=.true., scale=US%C_to_degC) + call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, omit_corners=.true., scale=US%S_to_ppt) call check_redundant("Pre-ALE ", u, v, G, unscale=US%L_T_to_m_s) endif call cpu_clock_begin(id_clock_ALE) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 80630084b9..bc908ee60c 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -39,7 +39,7 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, vel_scale) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, omit_corners, vel_scale) character(len=*), & intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -60,6 +60,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computational domain. + logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: vel_scale !< The scaling factor to convert velocities to [m s-1] real :: scale_vel ! The scaling factor to convert velocities to [m s-1] @@ -73,16 +74,17 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy sym = .false. ; if (present(symmetric)) sym=symmetric scale_vel = US%L_T_to_m_s ; if (present(vel_scale)) scale_vel = vel_scale - call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, scale=scale_vel) - call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) - call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, & + omit_corners=omit_corners, scale=scale_vel) + call hchksum(h, mesg//" h", G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_m) + call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, symmetric=sym, & + omit_corners=omit_corners, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= !> Write out chksums for the model's basic state variables. -subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) +subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric, omit_corners) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -97,6 +99,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. + logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts integer :: hs logical :: sym @@ -106,34 +109,43 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) ! and js...je as their extent. hs = 1 ; if (present(haloshift)) hs = haloshift sym = .false. ; if (present(symmetric)) sym = symmetric - call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, & + omit_corners=omit_corners, scale=US%L_T_to_m_s) + call hchksum(h, mesg//" h",G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg ! ============================================================================= !> Write out chksums for the model's thermodynamic state variables. -subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) +subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift, omit_corners) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts integer :: hs hs=1 ; if (present(haloshift)) hs=haloshift - if (associated(tv%T)) call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs, scale=US%C_to_degC) - if (associated(tv%S)) call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs, scale=US%S_to_ppt) - if (associated(tv%frazil)) call hchksum(tv%frazil, mesg//" frazil", G%HI, haloshift=hs, & - scale=US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m) - if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, & - scale=US%S_to_ppt*US%RZ_to_kg_m2) - if (associated(tv%varT)) call hchksum(tv%varT, mesg//" varT", G%HI, haloshift=hs, scale=US%C_to_degC**2) - if (associated(tv%varS)) call hchksum(tv%varS, mesg//" varS", G%HI, haloshift=hs, scale=US%S_to_ppt**2) - if (associated(tv%covarTS)) call hchksum(tv%covarTS, mesg//" covarTS", G%HI, haloshift=hs, & - scale=US%S_to_ppt*US%C_to_degC) + if (associated(tv%T)) & + call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%C_to_degC) + if (associated(tv%S)) & + call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%S_to_ppt) + if (associated(tv%frazil)) & + call hchksum(tv%frazil, mesg//" frazil", G%HI, haloshift=hs, omit_corners=omit_corners, & + scale=US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m) + if (associated(tv%salt_deficit)) & + call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, omit_corners=omit_corners, & + scale=US%S_to_ppt*US%RZ_to_kg_m2) + if (associated(tv%varT)) & + call hchksum(tv%varT, mesg//" varT", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%C_to_degC**2) + if (associated(tv%varS)) & + call hchksum(tv%varS, mesg//" varS", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%S_to_ppt**2) + if (associated(tv%covarTS)) & + call hchksum(tv%covarTS, mesg//" covarTS", G%HI, haloshift=hs, omit_corners=omit_corners, & + scale=US%S_to_ppt*US%C_to_degC) end subroutine MOM_thermo_chksum diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 1d7a70a55c..74ab4e1f18 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -647,7 +647,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & + call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=1, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G, unscale=US%L_T_to_m_s) call check_redundant("Predictor 1 uh", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -867,8 +867,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) + call uvchksum("Corrector 1 [uv]", u, v, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) + call hchksum(h, "Corrector 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 8d6eda728d..add2d6a984 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -260,7 +260,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T, & scalar_pair=.true.) - call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, & + call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=0, symmetric=.true., & scale=GV%H_to_m*(US%L_to_m**2)) endif @@ -293,7 +293,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo enddo if (CS%MEKE_advection_bug) then - ! This code obviously incorrect code reproduces a bug in the original implementation of + ! This obviously incorrect code reproduces a bug in the original implementation of ! the MEKE advection. do j=js,je ; do I=is-1,ie baroHu(I,j) = hu(I,j,nz) * GV%H_to_RZ From 8b528fd8957e4802788bce118d056d97c7800aff Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 30 Jan 2023 16:20:16 -0500 Subject: [PATCH 179/213] Document units of 30 driver variables Added or amended comments to document the units of 30 variables in FMS_cap/MOM_surface_forcing_gfdl.F90, FMS_cap/ocean_model_MOM.F90, solo_driver/MOM_surface_forcing and unit_drivers/MOM_sum_driver.F90. Only comments are changed, and all answers are bitwise identical. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 19 ++++++++++------- .../drivers/FMS_cap/ocean_model_MOM.F90 | 21 +++++++++---------- .../solo_driver/MOM_surface_forcing.F90 | 6 +++--- .../drivers/unit_drivers/MOM_sum_driver.F90 | 21 ++++++++++--------- 4 files changed, 35 insertions(+), 32 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index cd0106ec48..9a00f487e4 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -92,7 +92,7 @@ module MOM_surface_forcing_gfdl !! contributes to ustar [R L Z T-1 ~> Pa]. gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] - real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional) + real :: cd_tides !< Drag coefficient that applies to the tides [nondim] real :: utide !< Constant tidal velocity to use if read_tideamp is false [Z T-1 ~> m s-1]. logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. @@ -127,7 +127,7 @@ module MOM_surface_forcing_gfdl logical :: mask_srestore_marginal_seas !< If true, then mask SSS restoring in marginal seas real :: max_delta_srestore !< Maximum delta salinity used for restoring [S ~> ppt] real :: max_delta_trestore !< Maximum delta sst used for restoring [C ~> degC] - real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin [nondim] integer :: answer_date !< The vintage of the order of arithmetic and expressions in the !! gustiness calculations. Values below 20190101 recover the answers !! from the end of 2018, while higher values use a simpler expression @@ -144,14 +144,14 @@ module MOM_surface_forcing_gfdl !! salinity restoring fluxes. The masking file should be !! in inputdir/salt_restore_mask.nc and the field should !! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring [nondim] character(len=200) :: temp_restore_file !< Filename for sst restoring data character(len=30) :: temp_restore_var_name !< Name of surface temperature in temp_restore_file logical :: mask_trestore !< If true, apply a 2-dimensional mask to the surface !! temperature restoring fluxes. The masking file should be !! in inputdir/temp_restore_mask.nc and the field should !! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring [nondim] integer :: id_srestore = -1 !< An id number for time_interp_external. integer :: id_trestore = -1 !< An id number for time_interp_external. @@ -250,7 +250,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1] real :: rhoXcp ! Reference density times heat capacity times unit scaling ! factors [Q R C-1 ~> J m-3 degC-1] - real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. + real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1 [nondim] call cpu_clock_begin(id_clock_forcing) @@ -1169,7 +1169,10 @@ subroutine apply_force_adjustments(G, US, CS, Time, forces) real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points [R Z L T-2 ~> Pa] integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + real :: dLonDx, dLonDy ! The change in longitude across the cell in the x- and y-directions [degrees_E] + real :: rDlon ! The magnitude of the change in longitude [degrees_E] and then its inverse [degrees_E-1] + real :: cosA, sinA ! The cosine and sine of the angle between the grid and true north [nondim] + real :: zonal_tau, merid_tau ! True zonal and meridional wind stresses [R Z L T-2 ~> Pa] real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] logical :: overrode_x, overrode_y @@ -1714,8 +1717,8 @@ end subroutine ice_ocn_bnd_type_chksum !> Check the values passed by IOB over land are zero subroutine check_mask_val_consistency(val, mask, i, j, varname, G) - real, intent(in) :: val !< value of flux/variable passed by IOB - real, intent(in) :: mask !< value of ocean mask + real, intent(in) :: val !< value of flux/variable passed by IOB [various] + real, intent(in) :: mask !< value of ocean mask [nondim] integer, intent(in) :: i !< model grid cell indices integer, intent(in) :: j !< model grid cell indices character(len=*), intent(in) :: varname !< variable name diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 049ae3d3df..005e3a6723 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -462,7 +462,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! internal modules. type(time_type) :: Time1 ! The value of the ocean model's time at the start of a call to step_MOM. integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocean boundary type. - real :: weight ! Flux accumulation weight of the current fluxes. + real :: weight ! Flux accumulation weight of the current fluxes [nondim]. real :: dt_coupling ! The coupling time step [T ~> s]. real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s]. real :: dt_dyn ! The dynamics time step [T ~> s]. @@ -834,7 +834,6 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and ocean !! depth, usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1] ! Local variables - real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd integer :: i, j, i0, j0, is, ie, js, je @@ -989,7 +988,7 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. !! The data in OS is intent in. integer, intent(in) :: index !< The stock index for the quantity of interest. - real, intent(out) :: value !< Sum returned for the conservation quantity of interest. + real, intent(out) :: value !< Sum returned for the conservation quantity of interest [various] integer, optional, intent(in) :: time_index !< An unused optional argument, present only for !! interfacial compatibility with other models. ! Arguments: OS - A structure containing the internal ocean state. @@ -997,23 +996,23 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) ! (in) value - Sum returned for the conservation quantity of interest. ! (in,opt) time_index - Index for time level to use if this is necessary. - real :: salt + real :: salt ! The total salt in the ocean [kg] value = 0.0 if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return select case (index) - case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in kg. + case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in [kg]. if (OS%GV%Boussinesq) then call get_ocean_stocks(OS%MOM_CSp, mass=value, on_PE_only=.true.) else ! In non-Boussinesq mode, the mass of salt needs to be subtracted. call get_ocean_stocks(OS%MOM_CSp, mass=value, salt=salt, on_PE_only=.true.) value = value - salt endif - case (ISTOCK_HEAT) ! Return the heat content of the ocean in J. + case (ISTOCK_HEAT) ! Return the heat content of the ocean in [J]. call get_ocean_stocks(OS%MOM_CSp, heat=value, on_PE_only=.true.) - case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in kg. + case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in [kg]. call get_ocean_stocks(OS%MOM_CSp, salt=value, on_PE_only=.true.) case default ; value = 0.0 end select @@ -1032,7 +1031,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) !! visible ocean surface fields. character(len=*) , intent(in) :: name !< The name of the field to extract real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must - !! cover only the computational domain + !! cover only the computational domain [various] integer , intent(in) :: isc !< The starting i-index of array2D integer , intent(in) :: jsc !< The starting j-index of array2D @@ -1092,8 +1091,8 @@ subroutine ocean_model_data1D_get(OS, Ocean, name, value) !! internal ocean state (intent in). type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly !! visible ocean surface fields. - character(len=*) , intent(in) :: name !< The name of the field to extract - real , intent(out):: value !< The value of the named field + character(len=*), intent(in) :: name !< The name of the field to extract + real, intent(out):: value !< The value of the named field [various] if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return @@ -1155,7 +1154,7 @@ subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc) !! visible ocean surface fields. character(len=*) , intent(in) :: name !< The name of the current (ua or va) to extract real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must - !! cover only the computational domain + !! cover only the computational domain [L T-1 ~> m s-1] integer , intent(in) :: isc !< The starting i-index of array2D integer , intent(in) :: jsc !< The starting j-index of array2D diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 8b1c9aaa27..04612b4138 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -73,8 +73,8 @@ module MOM_surface_forcing logical :: adiabatic !< if true, no diapycnal mass fluxes or surface buoyancy forcing logical :: variable_winds !< if true, wind stresses vary with time logical :: variable_buoyforce !< if true, buoyancy forcing varies with time. - real :: south_lat !< southern latitude of the domain - real :: len_lat !< domain length in latitude + real :: south_lat !< southern latitude of the domain [degrees_N] or [km] or [m] + real :: len_lat !< domain length in latitude [degrees_N] or [km] or [m] real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] @@ -104,7 +104,7 @@ module MOM_surface_forcing real :: gyres_taux_const !< A constant wind stress [R L Z T-1 ~> Pa]. real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' - real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' + real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' [nondim] integer :: answer_date !< This 8-digit integer gives the approximate date with which the order !! of arithmetic and expressions were added to the code. !! Dates before 20190101 use original answers. diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index f962719d93..0a6191b286 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -51,7 +51,7 @@ program MOM_sum_driver logical :: unit_in_use real, allocatable, dimension(:) :: & - depth_tot_R, depth_tot_std, depth_tot_fastR + depth_tot_R, depth_tot_std, depth_tot_fastR ! Various sums of the depths [m] integer :: reproClock, fastreproClock, stdClock, initClock !----------------------------------------------------------------------- @@ -175,16 +175,17 @@ program MOM_sum_driver subroutine benchmark_init_topog_local(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth in [m] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters real, intent(in) :: max_depth !< The maximum ocean depth [m] - real :: min_depth ! The minimum ocean depth in m. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum ! - ! basin depth MAXIMUM_DEPTH. ! - real :: m_to_Z ! A dimensional rescaling factor. - real :: x, y + real :: min_depth ! The minimum ocean depth in [m]. + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] + real :: D0 ! A constant to make the maximum + ! basin depth MAXIMUM_DEPTH [m] + real :: m_to_Z ! A dimensional rescaling factor [m ~> Z] + real :: x ! A fractional position in the x-direction [nondim] + real :: y ! A fractional position in the y-direction [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_init_topog_local" ! This subroutine's name. @@ -203,8 +204,8 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) ! Calculate the depth of the bottom. do i=is,ie ; do j=js,je - x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat + x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon + y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat ! This sets topography that has a reentrant channel to the south. D(i,j) = -D0 * ( y*(1.0 + 0.6*cos(4.0*PI*x)) & + 0.75*exp(-6.0*y) & From 2b4627501ba3dfd4ea17d2b6e6ff37566f3d827f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 4 Feb 2023 15:57:32 -0500 Subject: [PATCH 180/213] Document units of 172 MOM_EOS_NEMO variables Added or amended comments to document the units of about 172 parameters or variables in MOM_EOS_NEMO.F90. Only comments are changed, and all answers are bitwise identical. --- src/equation_of_state/MOM_EOS_NEMO.F90 | 340 ++++++++++++++----------- 1 file changed, 185 insertions(+), 155 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index de4a715489..dee2bc48bf 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -22,8 +22,8 @@ module MOM_EOS_NEMO public calculate_density_derivs_nemo public calculate_density_scalar_nemo, calculate_density_array_nemo -!> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to -!! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), +!> Compute the in situ density of sea water [kg m-3], or its anomaly with respect to +!! a reference density, from absolute salinity [g kg-1], conservative temperature [degC], !! and pressure [Pa], using the expressions derived for use with NEMO interface calculate_density_nemo module procedure calculate_density_scalar_nemo, calculate_density_array_nemo @@ -37,138 +37,143 @@ module MOM_EOS_NEMO real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar [Pa dbar-1] !>@{ Parameters in the NEMO equation of state -real, parameter :: rdeltaS = 32. -real, parameter :: r1_S0 = 0.875/35.16504 -real, parameter :: r1_T0 = 1./40. -real, parameter :: r1_P0 = 1.e-4 -real, parameter :: R00 = 4.6494977072e+01 -real, parameter :: R01 = -5.2099962525 -real, parameter :: R02 = 2.2601900708e-01 -real, parameter :: R03 = 6.4326772569e-02 -real, parameter :: R04 = 1.5616995503e-02 -real, parameter :: R05 = -1.7243708991e-03 -real, parameter :: EOS000 = 8.0189615746e+02 -real, parameter :: EOS100 = 8.6672408165e+02 -real, parameter :: EOS200 = -1.7864682637e+03 -real, parameter :: EOS300 = 2.0375295546e+03 -real, parameter :: EOS400 = -1.2849161071e+03 -real, parameter :: EOS500 = 4.3227585684e+02 -real, parameter :: EOS600 = -6.0579916612e+01 -real, parameter :: EOS010 = 2.6010145068e+01 -real, parameter :: EOS110 = -6.5281885265e+01 -real, parameter :: EOS210 = 8.1770425108e+01 -real, parameter :: EOS310 = -5.6888046321e+01 -real, parameter :: EOS410 = 1.7681814114e+01 -real, parameter :: EOS510 = -1.9193502195 -real, parameter :: EOS020 = -3.7074170417e+01 -real, parameter :: EOS120 = 6.1548258127e+01 -real, parameter :: EOS220 = -6.0362551501e+01 -real, parameter :: EOS320 = 2.9130021253e+01 -real, parameter :: EOS420 = -5.4723692739 -real, parameter :: EOS030 = 2.1661789529e+01 -real, parameter :: EOS130 = -3.3449108469e+01 -real, parameter :: EOS230 = 1.9717078466e+01 -real, parameter :: EOS330 = -3.1742946532 -real, parameter :: EOS040 = -8.3627885467 -real, parameter :: EOS140 = 1.1311538584e+01 -real, parameter :: EOS240 = -5.3563304045 -real, parameter :: EOS050 = 5.4048723791e-01 -real, parameter :: EOS150 = 4.8169980163e-01 -real, parameter :: EOS060 = -1.9083568888e-01 -real, parameter :: EOS001 = 1.9681925209e+01 -real, parameter :: EOS101 = -4.2549998214e+01 -real, parameter :: EOS201 = 5.0774768218e+01 -real, parameter :: EOS301 = -3.0938076334e+01 -real, parameter :: EOS401 = 6.6051753097 -real, parameter :: EOS011 = -1.3336301113e+01 -real, parameter :: EOS111 = -4.4870114575 -real, parameter :: EOS211 = 5.0042598061 -real, parameter :: EOS311 = -6.5399043664e-01 -real, parameter :: EOS021 = 6.7080479603 -real, parameter :: EOS121 = 3.5063081279 -real, parameter :: EOS221 = -1.8795372996 -real, parameter :: EOS031 = -2.4649669534 -real, parameter :: EOS131 = -5.5077101279e-01 -real, parameter :: EOS041 = 5.5927935970e-01 -real, parameter :: EOS002 = 2.0660924175 -real, parameter :: EOS102 = -4.9527603989 -real, parameter :: EOS202 = 2.5019633244 -real, parameter :: EOS012 = 2.0564311499 -real, parameter :: EOS112 = -2.1311365518e-01 -real, parameter :: EOS022 = -1.2419983026 -real, parameter :: EOS003 = -2.3342758797e-02 -real, parameter :: EOS103 = -1.8507636718e-02 -real, parameter :: EOS013 = 3.7969820455e-01 -real, parameter :: ALP000 = -6.5025362670e-01 -real, parameter :: ALP100 = 1.6320471316 -real, parameter :: ALP200 = -2.0442606277 -real, parameter :: ALP300 = 1.4222011580 -real, parameter :: ALP400 = -4.4204535284e-01 -real, parameter :: ALP500 = 4.7983755487e-02 -real, parameter :: ALP010 = 1.8537085209 -real, parameter :: ALP110 = -3.0774129064 -real, parameter :: ALP210 = 3.0181275751 -real, parameter :: ALP310 = -1.4565010626 -real, parameter :: ALP410 = 2.7361846370e-01 -real, parameter :: ALP020 = -1.6246342147 -real, parameter :: ALP120 = 2.5086831352 -real, parameter :: ALP220 = -1.4787808849 -real, parameter :: ALP320 = 2.3807209899e-01 -real, parameter :: ALP030 = 8.3627885467e-01 -real, parameter :: ALP130 = -1.1311538584 -real, parameter :: ALP230 = 5.3563304045e-01 -real, parameter :: ALP040 = -6.7560904739e-02 -real, parameter :: ALP140 = -6.0212475204e-02 -real, parameter :: ALP050 = 2.8625353333e-02 -real, parameter :: ALP001 = 3.3340752782e-01 -real, parameter :: ALP101 = 1.1217528644e-01 -real, parameter :: ALP201 = -1.2510649515e-01 -real, parameter :: ALP301 = 1.6349760916e-02 -real, parameter :: ALP011 = -3.3540239802e-01 -real, parameter :: ALP111 = -1.7531540640e-01 -real, parameter :: ALP211 = 9.3976864981e-02 -real, parameter :: ALP021 = 1.8487252150e-01 -real, parameter :: ALP121 = 4.1307825959e-02 -real, parameter :: ALP031 = -5.5927935970e-02 -real, parameter :: ALP002 = -5.1410778748e-02 -real, parameter :: ALP102 = 5.3278413794e-03 -real, parameter :: ALP012 = 6.2099915132e-02 -real, parameter :: ALP003 = -9.4924551138e-03 -real, parameter :: BET000 = 1.0783203594e+01 -real, parameter :: BET100 = -4.4452095908e+01 -real, parameter :: BET200 = 7.6048755820e+01 -real, parameter :: BET300 = -6.3944280668e+01 -real, parameter :: BET400 = 2.6890441098e+01 -real, parameter :: BET500 = -4.5221697773 -real, parameter :: BET010 = -8.1219372432e-01 -real, parameter :: BET110 = 2.0346663041 -real, parameter :: BET210 = -2.1232895170 -real, parameter :: BET310 = 8.7994140485e-01 -real, parameter :: BET410 = -1.1939638360e-01 -real, parameter :: BET020 = 7.6574242289e-01 -real, parameter :: BET120 = -1.5019813020 -real, parameter :: BET220 = 1.0872489522 -real, parameter :: BET320 = -2.7233429080e-01 -real, parameter :: BET030 = -4.1615152308e-01 -real, parameter :: BET130 = 4.9061350869e-01 -real, parameter :: BET230 = -1.1847737788e-01 -real, parameter :: BET040 = 1.4073062708e-01 -real, parameter :: BET140 = -1.3327978879e-01 -real, parameter :: BET050 = 5.9929880134e-03 -real, parameter :: BET001 = -5.2937873009e-01 -real, parameter :: BET101 = 1.2634116779 -real, parameter :: BET201 = -1.1547328025 -real, parameter :: BET301 = 3.2870876279e-01 -real, parameter :: BET011 = -5.5824407214e-02 -real, parameter :: BET111 = 1.2451933313e-01 -real, parameter :: BET211 = -2.4409539932e-02 -real, parameter :: BET021 = 4.3623149752e-02 -real, parameter :: BET121 = -4.6767901790e-02 -real, parameter :: BET031 = -6.8523260060e-03 -real, parameter :: BET002 = -6.1618945251e-02 -real, parameter :: BET102 = 6.2255521644e-02 -real, parameter :: BET012 = -2.6514181169e-03 -real, parameter :: BET003 = -2.3025968587e-04 +real, parameter :: rdeltaS = 32. ! An offset to salinity before taking its square root [g kg-1] +real, parameter :: r1_S0 = 0.875/35.16504 ! The inverse of a plausible range of oceanic salinities [kg g-1] +real, parameter :: r1_T0 = 1./40. ! The inverse of a plausible range of oceanic temperatures [degC-1] +real, parameter :: r1_P0 = 1.e-4 ! The inverse of a plausible range of oceanic pressures [dbar-1] +real, parameter :: R00 = 4.6494977072e+01 ! Contribution to zr0 proportional to zp [kg m-3] +real, parameter :: R01 = -5.2099962525 ! Contribution to zr0 proportional to zp**2 [kg m-3] +real, parameter :: R02 = 2.2601900708e-01 ! Contribution to zr0 proportional to zp**3 [kg m-3] +real, parameter :: R03 = 6.4326772569e-02 ! Contribution to zr0 proportional to zp**4 [kg m-3] +real, parameter :: R04 = 1.5616995503e-02 ! Contribution to zr0 proportional to zp**5 [kg m-3] +real, parameter :: R05 = -1.7243708991e-03 ! Contribution to zr0 proportional to zp**6 [kg m-3] + +! The following terms are contributions to density as a function of the normalized square root of salinity +! with an offset (zs), temperature (zt) and pressure, with a contribution EOSabc * zs**a * zt**b * zp**c +real, parameter :: EOS000 = 8.0189615746e+02 ! A constant density contribution [kg m-3] +real, parameter :: EOS100 = 8.6672408165e+02 ! Coefficient of the EOS proportional to zs [kg m-3] +real, parameter :: EOS200 = -1.7864682637e+03 ! Coefficient of the EOS proportional to zs**2 [kg m-3] +real, parameter :: EOS300 = 2.0375295546e+03 ! Coefficient of the EOS proportional to zs**3 [kg m-3] +real, parameter :: EOS400 = -1.2849161071e+03 ! Coefficient of the EOS proportional to zs**4 [kg m-3] +real, parameter :: EOS500 = 4.3227585684e+02 ! Coefficient of the EOS proportional to zs**5 [kg m-3] +real, parameter :: EOS600 = -6.0579916612e+01 ! Coefficient of the EOS proportional to zs**6 [kg m-3] +real, parameter :: EOS010 = 2.6010145068e+01 ! Coefficient of the EOS proportional to zt [kg m-3] +real, parameter :: EOS110 = -6.5281885265e+01 ! Coefficient of the EOS proportional to zs * zt [kg m-3] +real, parameter :: EOS210 = 8.1770425108e+01 ! Coefficient of the EOS proportional to zs**2 * zt [kg m-3] +real, parameter :: EOS310 = -5.6888046321e+01 ! Coefficient of the EOS proportional to zs**3 * zt [kg m-3] +real, parameter :: EOS410 = 1.7681814114e+01 ! Coefficient of the EOS proportional to zs**2 * zt [kg m-3] +real, parameter :: EOS510 = -1.9193502195 ! Coefficient of the EOS proportional to zs**5 * zt [kg m-3] +real, parameter :: EOS020 = -3.7074170417e+01 ! Coefficient of the EOS proportional to zt**2 [kg m-3] +real, parameter :: EOS120 = 6.1548258127e+01 ! Coefficient of the EOS proportional to zs * zt**2 [kg m-3] +real, parameter :: EOS220 = -6.0362551501e+01 ! Coefficient of the EOS proportional to zs**2 * zt**2 [kg m-3] +real, parameter :: EOS320 = 2.9130021253e+01 ! Coefficient of the EOS proportional to s**3 * zt**2 [kg m-3] +real, parameter :: EOS420 = -5.4723692739 ! Coefficient of the EOS proportional to zs**4 * zt**2 [kg m-3] +real, parameter :: EOS030 = 2.1661789529e+01 ! Coefficient of the EOS proportional to zt**3 [kg m-3] +real, parameter :: EOS130 = -3.3449108469e+01 ! Coefficient of the EOS proportional to zs * zt**3 [kg m-3] +real, parameter :: EOS230 = 1.9717078466e+01 ! Coefficient of the EOS proportional to zs**2 * zt**3 [kg m-3] +real, parameter :: EOS330 = -3.1742946532 ! Coefficient of the EOS proportional to zs**3 * zt**3 [kg m-3] +real, parameter :: EOS040 = -8.3627885467 ! Coefficient of the EOS proportional to zt**4 [kg m-3] +real, parameter :: EOS140 = 1.1311538584e+01 ! Coefficient of the EOS proportional to zs * zt**4 [kg m-3] +real, parameter :: EOS240 = -5.3563304045 ! Coefficient of the EOS proportional to zs**2 * zt**4 [kg m-3] +real, parameter :: EOS050 = 5.4048723791e-01 ! Coefficient of the EOS proportional to zt**5 [kg m-3] +real, parameter :: EOS150 = 4.8169980163e-01 ! Coefficient of the EOS proportional to zs * zt**5 [kg m-3] +real, parameter :: EOS060 = -1.9083568888e-01 ! Coefficient of the EOS proportional to zt**6 [kg m-3] +real, parameter :: EOS001 = 1.9681925209e+01 ! Coefficient of the EOS proportional to zp [kg m-3] +real, parameter :: EOS101 = -4.2549998214e+01 ! Coefficient of the EOS proportional to zs * zp [kg m-3] +real, parameter :: EOS201 = 5.0774768218e+01 ! Coefficient of the EOS proportional to zs**2 * zp [kg m-3] +real, parameter :: EOS301 = -3.0938076334e+01 ! Coefficient of the EOS proportional to zs**3 * zp [kg m-3] +real, parameter :: EOS401 = 6.6051753097 ! Coefficient of the EOS proportional to zs**4 * zp [kg m-3] +real, parameter :: EOS011 = -1.3336301113e+01 ! Coefficient of the EOS proportional to zt * zp [kg m-3] +real, parameter :: EOS111 = -4.4870114575 ! Coefficient of the EOS proportional to zs * zt * zp [kg m-3] +real, parameter :: EOS211 = 5.0042598061 ! Coefficient of the EOS proportional to zs**2 * zt * zp [kg m-3] +real, parameter :: EOS311 = -6.5399043664e-01 ! Coefficient of the EOS proportional to zs**3 * zt * zp [kg m-3] +real, parameter :: EOS021 = 6.7080479603 ! Coefficient of the EOS proportional to zt**2 * zp [kg m-3] +real, parameter :: EOS121 = 3.5063081279 ! Coefficient of the EOS proportional to zs * zt**2 * zp [kg m-3] +real, parameter :: EOS221 = -1.8795372996 ! Coefficient of the EOS proportional to zs**2 * zt**2 * zp [kg m-3] +real, parameter :: EOS031 = -2.4649669534 ! Coefficient of the EOS proportional to zt**3 * zp [kg m-3] +real, parameter :: EOS131 = -5.5077101279e-01 ! Coefficient of the EOS proportional to zs * zt**3 * zp [kg m-3] +real, parameter :: EOS041 = 5.5927935970e-01 ! Coefficient of the EOS proportional to zt**4 * zp [kg m-3] +real, parameter :: EOS002 = 2.0660924175 ! Coefficient of the EOS proportional to zp**2 [kg m-3] +real, parameter :: EOS102 = -4.9527603989 ! Coefficient of the EOS proportional to zs * zp**2 [kg m-3] +real, parameter :: EOS202 = 2.5019633244 ! Coefficient of the EOS proportional to zs**2 * zp**2 [kg m-3] +real, parameter :: EOS012 = 2.0564311499 ! Coefficient of the EOS proportional to zt * zp**2 [kg m-3] +real, parameter :: EOS112 = -2.1311365518e-01 ! Coefficient of the EOS proportional to zs * zt * zp**2 [kg m-3] +real, parameter :: EOS022 = -1.2419983026 ! Coefficient of the EOS proportional to zt**2 * zp**2 [kg m-3] +real, parameter :: EOS003 = -2.3342758797e-02 ! Coefficient of the EOS proportional to zp**3 [kg m-3] +real, parameter :: EOS103 = -1.8507636718e-02 ! Coefficient of the EOS proportional to zs * zp**3 [kg m-3] +real, parameter :: EOS013 = 3.7969820455e-01 ! Coefficient of the EOS proportional to zt * zp**3 [kg m-3] + +real, parameter :: ALP000 = -6.5025362670e-01 ! Constant in the drho_dT fit [kg m-3 degC-1] +real, parameter :: ALP100 = 1.6320471316 ! Coefficient of the drho_dT fit zs term [kg m-3 degC-1] +real, parameter :: ALP200 = -2.0442606277 ! Coefficient of the drho_dT fit zs**2 term [kg m-3 degC-1] +real, parameter :: ALP300 = 1.4222011580 ! Coefficient of the drho_dT fit zs**3 term [kg m-3 degC-1] +real, parameter :: ALP400 = -4.4204535284e-01 ! Coefficient of the drho_dT fit zs**4 term [kg m-3 degC-1] +real, parameter :: ALP500 = 4.7983755487e-02 ! Coefficient of the drho_dT fit zs**5 term [kg m-3 degC-1] +real, parameter :: ALP010 = 1.8537085209 ! Coefficient of the drho_dT fit zt term [kg m-3 degC-1] +real, parameter :: ALP110 = -3.0774129064 ! Coefficient of the drho_dT fit zs * zt term [kg m-3 degC-1] +real, parameter :: ALP210 = 3.0181275751 ! Coefficient of the drho_dT fit zs**2 * zt term [kg m-3 degC-1] +real, parameter :: ALP310 = -1.4565010626 ! Coefficient of the drho_dT fit zs**3 * zt term [kg m-3 degC-1] +real, parameter :: ALP410 = 2.7361846370e-01 ! Coefficient of the drho_dT fit zs**4 * zt term [kg m-3 degC-1] +real, parameter :: ALP020 = -1.6246342147 ! Coefficient of the drho_dT fit zt**2 term [kg m-3 degC-1] +real, parameter :: ALP120 = 2.5086831352 ! Coefficient of the drho_dT fit zs * zt**2 term [kg m-3 degC-1] +real, parameter :: ALP220 = -1.4787808849 ! Coefficient of the drho_dT fit zs**2 * zt**2 term [kg m-3 degC-1] +real, parameter :: ALP320 = 2.3807209899e-01 ! Coefficient of the drho_dT fit zs**3 * zt**2 term [kg m-3 degC-1] +real, parameter :: ALP030 = 8.3627885467e-01 ! Coefficient of the drho_dT fit zt**3 term [kg m-3 degC-1] +real, parameter :: ALP130 = -1.1311538584 ! Coefficient of the drho_dT fit zs * zt**3 term [kg m-3 degC-1] +real, parameter :: ALP230 = 5.3563304045e-01 ! Coefficient of the drho_dT fit zs**2 * zt**3 term [kg m-3 degC-1] +real, parameter :: ALP040 = -6.7560904739e-02 ! Coefficient of the drho_dT fit zt**4 term [kg m-3 degC-1] +real, parameter :: ALP140 = -6.0212475204e-02 ! Coefficient of the drho_dT fit zs* * zt**4 term [kg m-3 degC-1] +real, parameter :: ALP050 = 2.8625353333e-02 ! Coefficient of the drho_dT fit zt**5 term [kg m-3 degC-1] +real, parameter :: ALP001 = 3.3340752782e-01 ! Coefficient of the drho_dT fit zp term [kg m-3 degC-1] +real, parameter :: ALP101 = 1.1217528644e-01 ! Coefficient of the drho_dT fit zs * zp term [kg m-3 degC-1] +real, parameter :: ALP201 = -1.2510649515e-01 ! Coefficient of the drho_dT fit zs**2 * zp term [kg m-3 degC-1] +real, parameter :: ALP301 = 1.6349760916e-02 ! Coefficient of the drho_dT fit zs**3 * zp term [kg m-3 degC-1] +real, parameter :: ALP011 = -3.3540239802e-01 ! Coefficient of the drho_dT fit zt * zp term [kg m-3 degC-1] +real, parameter :: ALP111 = -1.7531540640e-01 ! Coefficient of the drho_dT fit zs * zt * zp term [kg m-3 degC-1] +real, parameter :: ALP211 = 9.3976864981e-02 ! Coefficient of the drho_dT fit zs**2 * zt * zp term [kg m-3 degC-1] +real, parameter :: ALP021 = 1.8487252150e-01 ! Coefficient of the drho_dT fit zt**2 * zp term [kg m-3 degC-1] +real, parameter :: ALP121 = 4.1307825959e-02 ! Coefficient of the drho_dT fit zs * zt**2 * zp term [kg m-3 degC-1] +real, parameter :: ALP031 = -5.5927935970e-02 ! Coefficient of the drho_dT fit zt**3 * zp term [kg m-3 degC-1] +real, parameter :: ALP002 = -5.1410778748e-02 ! Coefficient of the drho_dT fit zp**2 term [kg m-3 degC-1] +real, parameter :: ALP102 = 5.3278413794e-03 ! Coefficient of the drho_dT fit zs * zp**2 term [kg m-3 degC-1] +real, parameter :: ALP012 = 6.2099915132e-02 ! Coefficient of the drho_dT fit zt * zp**2 term [kg m-3 degC-1] +real, parameter :: ALP003 = -9.4924551138e-03 ! Coefficient of the drho_dT fit zp**3 term [kg m-3 degC-1] + +real, parameter :: BET000 = 1.0783203594e+01 ! Constant in the drho_dS fit [kg m-3 ppt-1] +real, parameter :: BET100 = -4.4452095908e+01 ! Coefficient of the drho_dS fit zs term [kg m-3 ppt-1] +real, parameter :: BET200 = 7.6048755820e+01 ! Coefficient of the drho_dS fit zs**2 term [kg m-3 ppt-1] +real, parameter :: BET300 = -6.3944280668e+01 ! Coefficient of the drho_dS fit zs**3 term [kg m-3 ppt-1] +real, parameter :: BET400 = 2.6890441098e+01 ! Coefficient of the drho_dS fit zs**4 term [kg m-3 ppt-1] +real, parameter :: BET500 = -4.5221697773 ! Coefficient of the drho_dS fit zs**5 term [kg m-3 ppt-1] +real, parameter :: BET010 = -8.1219372432e-01 ! Coefficient of the drho_dS fit zt term [kg m-3 ppt-1] +real, parameter :: BET110 = 2.0346663041 ! Coefficient of the drho_dS fit zs * zt term [kg m-3 ppt-1] +real, parameter :: BET210 = -2.1232895170 ! Coefficient of the drho_dS fit zs**2 * zt term [kg m-3 ppt-1] +real, parameter :: BET310 = 8.7994140485e-01 ! Coefficient of the drho_dS fit zs**3 * zt term [kg m-3 ppt-1] +real, parameter :: BET410 = -1.1939638360e-01 ! Coefficient of the drho_dS fit zs**4 * zt term [kg m-3 ppt-1] +real, parameter :: BET020 = 7.6574242289e-01 ! Coefficient of the drho_dS fit zt**2 term [kg m-3 ppt-1] +real, parameter :: BET120 = -1.5019813020 ! Coefficient of the drho_dS fit zs * zt**2 term [kg m-3 ppt-1] +real, parameter :: BET220 = 1.0872489522 ! Coefficient of the drho_dS fit zs**2 * zt**2 term [kg m-3 ppt-1] +real, parameter :: BET320 = -2.7233429080e-01 ! Coefficient of the drho_dS fit zs**3 * zt**2 term [kg m-3 ppt-1] +real, parameter :: BET030 = -4.1615152308e-01 ! Coefficient of the drho_dS fit zt**3 term [kg m-3 ppt-1] +real, parameter :: BET130 = 4.9061350869e-01 ! Coefficient of the drho_dS fit zs * zt**3 term [kg m-3 ppt-1] +real, parameter :: BET230 = -1.1847737788e-01 ! Coefficient of the drho_dS fit zs**2 * zt**3 term [kg m-3 ppt-1] +real, parameter :: BET040 = 1.4073062708e-01 ! Coefficient of the drho_dS fit zt**4 term [kg m-3 ppt-1] +real, parameter :: BET140 = -1.3327978879e-01 ! Coefficient of the drho_dS fit zs * zt**4 term [kg m-3 ppt-1] +real, parameter :: BET050 = 5.9929880134e-03 ! Coefficient of the drho_dS fit zt**5 term [kg m-3 ppt-1] +real, parameter :: BET001 = -5.2937873009e-01 ! Coefficient of the drho_dS fit zp term [kg m-3 ppt-1] +real, parameter :: BET101 = 1.2634116779 ! Coefficient of the drho_dS fit zs * zp term [kg m-3 ppt-1] +real, parameter :: BET201 = -1.1547328025 ! Coefficient of the drho_dS fit zs**2 * zp term [kg m-3 ppt-1] +real, parameter :: BET301 = 3.2870876279e-01 ! Coefficient of the drho_dS fit zs**3 * zp term [kg m-3 ppt-1] +real, parameter :: BET011 = -5.5824407214e-02 ! Coefficient of the drho_dS fit zt * zp term [kg m-3 ppt-1] +real, parameter :: BET111 = 1.2451933313e-01 ! Coefficient of the drho_dS fit zs * zt * zp term [kg m-3 ppt-1] +real, parameter :: BET211 = -2.4409539932e-02 ! Coefficient of the drho_dS fit zs**2 * zt * zp term [kg m-3 ppt-1] +real, parameter :: BET021 = 4.3623149752e-02 ! Coefficient of the drho_dS fit zt**2 * zp term [kg m-3 ppt-1] +real, parameter :: BET121 = -4.6767901790e-02 ! Coefficient of the drho_dS fit zs * zt**2 * zp term [kg m-3 ppt-1] +real, parameter :: BET031 = -6.8523260060e-03 ! Coefficient of the drho_dS fit zt**3 * zp term [kg m-3 ppt-1] +real, parameter :: BET002 = -6.1618945251e-02 ! Coefficient of the drho_dS fit zp**2 term [kg m-3 ppt-1] +real, parameter :: BET102 = 6.2255521644e-02 ! Coefficient of the drho_dS fit zs * zp**2 term [kg m-3 ppt-1] +real, parameter :: BET012 = -2.6514181169e-03 ! Coefficient of the drho_dS fit zt * zp**2 term [kg m-3 ppt-1] +real, parameter :: BET003 = -2.3025968587e-04 ! Coefficient of the drho_dS fit zp**3 term [kg m-3 ppt-1] !>@} contains @@ -212,20 +217,31 @@ subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_re real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: zp, zt, zs, zr0, zn, zn0, zn1, zn2, zn3, zs0 + real :: zp ! Pressure, first in [dbar], then normalized by an assumed pressure range [nondim] + real :: zt ! Conservative temperature, first in [degC], then normalized by an assumed temperature range [nondim] + real :: zs ! Absolute salinity, first in [g kg-1], then the square root of salinity with an offset normalized + ! by an assumed salnity range [nondim] + real :: zr0 ! A pressure-dependent but temperature and salinity independent contribution to + ! density at the reference temperature and salinity [kg m-3] + real :: zn ! Density without a pressure-dependent contribution [kg m-3] + real :: zn0 ! A contribution to density from temperature and salinity anomalies at the surface pressure [kg m-3] + real :: zn1 ! A temperature and salinity dependent density contribution proportional to pressure [kg m-3] + real :: zn2 ! A temperature and salinity dependent density contribution proportional to pressure^2 [kg m-3] + real :: zn3 ! A temperature and salinity dependent density contribution proportional to pressure^3 [kg m-3] + real :: zs0 ! Salinity dependent density at the surface pressure and temperature [kg m-3] integer :: j do j=start,start+npts-1 - !Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp - zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar + ! Conversions + zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] !The following algorithm was provided by Roquet in a private communication. !It is not necessarily the algorithm used in NEMO ocean! - zp = zp * r1_P0 !pressure - zt = zt * r1_T0 !temperature - zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root salinity + zp = zp * r1_P0 ! pressure normalized by a plausible range of pressure in the ocean [nondim] + zt = zt * r1_T0 ! temperature normalized by a plausible oceanic range [nondim] + zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] zn3 = EOS013*zt & & + EOS103*zs+EOS003 @@ -276,20 +292,33 @@ subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zp, zt, zs, zn, zn0, zn1, zn2, zn3 + real :: zp ! Pressure, first in [dbar], then normalized by an assumed pressure range [nondim] + real :: zt ! Conservative temperature, first in [degC], then normalized by an assumed temperature range [nondim] + real :: zs ! Absolute salinity, first in [g kg-1], then the square root of salinity with an offset normalized + ! by an assumed salnity range [nondim] + real :: zn ! Partial derivative of density with temperature [kg m-3 degC-1] or salinity [kg m-3 ppt-1] + ! without a pressure-dependent contribution + real :: zn0 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] from temperature anomalies at the surface pressure + real :: zn1 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] proportional to pressure + real :: zn2 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] proportional to pressure^2 + real :: zn3 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] proportional to pressure^3 integer :: j do j=start,start+npts-1 - !Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp - zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar + ! Conversions + zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] !The following algorithm was provided by Roquet in a private communication. !It is not necessarily the algorithm used in NEMO ocean! - zp = zp * r1_P0 ! pressure (first converted to decibar) - zt = zt * r1_T0 ! temperature - zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root salinity + zp = zp * r1_P0 ! pressure normalized by a plausible range of pressure in the ocean [nondim] + zt = zt * r1_T0 ! temperature normalized by a plausible oceanic range [nondim] + zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] ! ! alpha zn3 = ALP003 @@ -331,7 +360,8 @@ subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 ! zn = ( ( zn3 * zp + zn2 ) * zp + zn1 ) * zp + zn0 - ! + + ! The division by zs here is because zs = sqrt(S + S0), so drho_dS = dzs_dS * drho_dzs = (0.5 / zs) * drho_dzs drho_dS(j) = zn / zs enddo @@ -391,10 +421,10 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) ! since the corresponding NEMO approximation is not available yet. ! do j=start,start+npts-1 - !Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp - zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar + ! Conversions + zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] call gsw_rho_first_derivatives(zs,zt,zp, drho_dp=drho_dp(j)) enddo end subroutine calculate_compress_nemo From f54956edd2fdc0c86de8f7a6529baf4f1dba49cc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Feb 2023 17:45:48 -0500 Subject: [PATCH 181/213] +Add optional unscale argument to log_param_real This commit adds an optional unscale argument to the log_param_real interfaces. All answers and output are bitwise identical. --- src/framework/MOM_file_parser.F90 | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 3a25981dc8..fd447f5193 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1411,7 +1411,7 @@ end subroutine log_param_int_array !> Log the name and value of a real model parameter in documentation files. subroutine log_param_real(CS, modulename, varname, value, desc, units, & - default, debuggingParam, like_default) + default, debuggingParam, like_default, unscale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1425,26 +1425,31 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & !! logged in the debugging parameter file logical, optional, intent(in) :: like_default !< If present and true, log this parameter as !! though it has the default value, even if there is no default. + real, optional, intent(in) :: unscale !< A reciprocal scaling factor that the parameter is + !! multiplied by before it is logged + real :: log_val ! The parameter value that is written out character(len=240) :: mesg, myunits + log_val = value ; if (present(unscale)) log_val = unscale * value + write(mesg, '(" ",a," ",a,": ",a)') & - trim(modulename), trim(varname), trim(left_real(value)) + trim(modulename), trim(varname), trim(left_real(log_val)) if (is_root_pe()) then if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg) if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg) endif - myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) + write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default, & + call doc_param(CS%doc, varname, desc, myunits, log_val, default, & debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_real !> Log the name and values of an array of real model parameter in documentation files. subroutine log_param_real_array(CS, modulename, varname, value, desc, & - units, default, debuggingParam, like_default) + units, default, debuggingParam, like_default, unscale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1458,22 +1463,27 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & !! logged in the debugging parameter file logical, optional, intent(in) :: like_default !< If present and true, log this parameter as !! though it has the default value, even if there is no default. + real, optional, intent(in) :: unscale !< A reciprocal scaling factor that the parameter is + !! multiplied by before it is logged + real, dimension(size(value)) :: log_val ! The array of parameter values that is written out character(len=:), allocatable :: mesg character(len=240) :: myunits + log_val(:) = value(:) ; if (present(unscale)) log_val(:) = unscale * value(:) + !write(mesg, '(" ",a," ",a,": ",ES19.12,99(",",ES19.12))') & !write(mesg, '(" ",a," ",a,": ",G,99(",",G))') & ! trim(modulename), trim(varname), value - mesg = " " // trim(modulename) // " " // trim(varname) // ": " // trim(left_reals(value)) + mesg = " " // trim(modulename) // " " // trim(varname) // ": " // trim(left_reals(log_val)) if (is_root_pe()) then if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg) if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg) endif - myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) + write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default, & + call doc_param(CS%doc, varname, desc, myunits, log_val, default, & debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_real_array From ad56b29f1e38be507205c96fefbd151b2ff63151 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Feb 2023 17:47:57 -0500 Subject: [PATCH 182/213] Use unscale argument in 10 log_param calls Use the new unscale optional argument in 10 log_param calls for real variables. All answers and output are bitwise identical. --- src/core/MOM_barotropic.F90 | 4 ++-- src/diagnostics/MOM_sum_output.F90 | 3 ++- src/initialization/MOM_fixed_initialization.F90 | 9 +++++---- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 4 ++-- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 5 +++-- src/parameterizations/vertical/MOM_vert_friction.F90 | 8 ++++---- src/tracer/oil_tracer.F90 | 3 ++- 7 files changed, 20 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 105e81732a..bb77a99c4c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4804,8 +4804,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false. - call log_param(param_file, mdl, "DTBT as used", CS%dtbt*US%T_to_s, units="s") - call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max*US%T_to_s, units="s") + call log_param(param_file, mdl, "DTBT as used", CS%dtbt, units="s", unscale=US%T_to_s) + call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max, units="s", unscale=US%T_to_s) ! ubtav and vbtav, and perhaps ubt_IC and vbt_IC, are allocated and ! initialized in register_barotropic_restarts. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 6dbe4997d6..94f34a6c56 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -199,7 +199,8 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & "The maximum velocity allowed before the velocity "//& "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) CS%max_Energy = 10.0 * maxvel**2 - call log_param(param_file, mdl, "MAX_ENERGY as used", US%L_T_to_m_s**2*CS%max_Energy, units="m2 s-2") + call log_param(param_file, mdl, "MAX_ENERGY as used", CS%max_Energy, & + units="m2 s-2", unscale=US%L_T_to_m_s**2) endif call get_param(param_file, mdl, "ENERGYFILE", energyfile, & diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 0cc3794543..322abc6d5e 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -244,12 +244,13 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*US%Z_to_m, & - "The maximum depth of the ocean.", units="m") + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, & + "The maximum depth of the ocean.", units="m", unscale=US%Z_to_m) else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*US%Z_to_m, & - "The (diagnosed) maximum depth of the ocean.", units="m", like_default=.true.) + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & + "The (diagnosed) maximum depth of the ocean.", & + units="m", unscale=US%Z_to_m, like_default=.true.) endif if (trim(config) /= "DOME") then call limit_topography(D, G, PF, max_depth, US) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 12a32e7376..01f8303ae2 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -176,11 +176,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL if (abs(CS%Kd_tot_ml - CS%Kd) > 1.0e-15*abs(CS%Kd)) & call MOM_error(WARNING, "KDML is a depricated parameter. Use KD_ML_TOT instead.") endif - call log_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml*US%Z2_T_to_m2_s, & + call log_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & "The total diapcynal diffusivity in the surface mixed layer when there is "//& "not a physically based parameterization of mixing in the mixed layer, such "//& "as bulk mixed layer or KPP or ePBL.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, unscale=US%Z2_T_to_m2_s) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface "//& diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 01885a0484..641816513c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2321,9 +2321,10 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Logging parameters ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & + call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min, & "The (tiny) minimum friction velocity used within the "//& - "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1", & + "ePBL code, derived from OMEGA and ANGSTROM.", & + units="m s-1", unscale=US%Z_to_m*US%s_to_T, & like_default=.true.) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 819b2ea8b3..ea6c7f112b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2339,14 +2339,14 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call MOM_error(WARNING, "KVML is a deprecated parameter. Use KV_ML_INVZ2 instead.") endif if (CS%Kvml_invZ2 < 0.0) CS%Kvml_invZ2 = 0.0 - call log_param(param_file, mdl, "KV_ML_INVZ2", US%Z2_T_to_m2_s*CS%Kvml_invZ2, & + call log_param(param_file, mdl, "KV_ML_INVZ2", CS%Kvml_invZ2, & "An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, "//& "with the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the "//& "distance from the surface, to allow for finite wind stresses to be "//& "transmitted through infinitesimally thin surface layers. This is an "//& "older option for numerical convenience without a strong physical basis, "//& "and its use is now discouraged.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s) endif if (.not.CS%bottomdraglaw) then @@ -2364,10 +2364,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%Kv_extra_bbl = Kv_BBL - CS%Kv endif endif - call log_param(param_file, mdl, "KV_EXTRA_BBL", US%Z2_T_to_m2_s*CS%Kv_extra_bbl, & + call log_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, & "An extra kinematic viscosity in the benthic boundary layer. "//& "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s) endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a viscosity increased by "//& diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 544188bb7a..36b157547f 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -165,7 +165,8 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) endif endif enddo - call log_param(param_file, mdl, "OIL_DECAY_RATE", US%s_to_T*CS%oil_decay_rate(1:CS%ntr), units="s-1") + call log_param(param_file, mdl, "OIL_DECAY_RATE", CS%oil_decay_rate(1:CS%ntr), & + units="s-1", unscale=US%s_to_T) ! This needs to be changed if the units of tracer are changed above. if (GV%Boussinesq) then ; flux_units = "kg s-1" From 2fe2631ee9c79357a2898b1efd20bc8cbc228245 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Feb 2023 13:51:41 -0500 Subject: [PATCH 183/213] (*)Fix bug in CVMix_shear_is_used if USE_PP81=True Because get_param is case-sensitive, CVMix_shear_is_used can incorrectly return false if USE_PP81 = True and USE_LMD94 = False. This would cause such cases to fail to reproduce across restarts or use uninitialize or incorrect arrays, but because the Pacanowski and Philader parameterization is very out-dated it appears not to be used in any active test case. Moreover, no one has reported any such issues yet. Therefore, rather than adding a flag to reproduce the old (unreproducing) results, this commit simply corrects this bug. The (case-sensitive) parameter "Use_PP81" was also formally obsoleted. All answers are bitwise identical in all known MOM6 configurations, but this could lead to answer changes in certain unlikely configurations. --- src/diagnostics/MOM_obsolete_params.F90 | 3 ++- src/parameterizations/vertical/MOM_CVMix_shear.F90 | 8 ++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index cea0c82bcf..99e6c386c6 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -89,6 +89,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) + call obsolete_logical(param_file, "Use_PP81", hint="get_param is case sensitive so use USE_PP81.") call obsolete_logical(param_file, "ALLOW_CLOCKS_IN_OMP_LOOPS", .true.) call obsolete_logical(param_file, "LARGE_FILE_SUPPORT", .true.) @@ -114,7 +115,7 @@ subroutine obsolete_logical(param_file, varname, warning_val, hint) logical :: test_logic, fatal_err character(len=128) :: hint_msg - test_logic = .false. ; call read_param(param_file, varname,test_logic) + test_logic = .false. ; call read_param(param_file, varname, test_logic) fatal_err = .true. if (present(warning_val)) fatal_err = (warning_val .neqv. .true.) hint_msg = " " ; if (present(hint)) hint_msg = hint diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 4f13cf5793..7c927b0dfc 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -318,7 +318,7 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) end function CVMix_shear_init -!> Reads the parameters "LMD94" and "PP81" and returns state. +!> Reads the parameters "USE_LMD94" and "USE_PP81" and returns true if either is true. !! This function allows other modules to know whether this parameterization will !! be used without needing to duplicate the log entry. logical function CVMix_shear_is_used(param_file) @@ -326,9 +326,9 @@ logical function CVMix_shear_is_used(param_file) ! Local variables logical :: LMD94, PP81 call get_param(param_file, mdl, "USE_LMD94", LMD94, & - default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "Use_PP81", PP81, & - default=.false., do_not_log=.true.) + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_PP81", PP81, & + default=.false., do_not_log=.true.) CVMix_shear_is_used = (LMD94 .or. PP81) end function CVMix_shear_is_used From 4c3b409c48f78f3d3d5ad359d2a4e451b485b5b8 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 2 Feb 2023 14:04:25 -0500 Subject: [PATCH 184/213] Direct netCDF data reads This patch introduces `read_netCDF_data`, a new method for reading netCDF datasets using the native netCDF I/O interface. It is designed to resemble the existing `MOM_read_data` function. Motivation ---------- Legacy input files may contain content which is not supported by the newest framework I/O (FMS). In order to retain support for these input files, particularly over a wider range of compilers, this patch provides an alternative method for reading these files. Interface --------- As with `MOM_read_data`, the function is provided with a netCDF filepath and a variable name, and returns the values to a provided variable. The `global_file` and `file_may_be_4d` flags have been dropped, since they are related to specific FMS2 compatibility issues. (Global vs domain-decomposed reads is controlled by the presence of a `MOM_domain`) Limited domain-decomposed I/O is supported, providing parallel I/O over a single file, to the extent supported by the filesystem. Parallelization over multiple files, as in FMS I/O, is not supported. Each FMS PE (MPI rank) reads its own segment, as defined by its MOM_domain. Output can be saved to either compute or data domains; as in FMS, the appropriate placement is inferred from the size of the output array. Support is currently limited to time-independent 2D arrays with center-cell indexing. That is, the `position` and `timelevel` arguments are not yet supported. The subroutines raise an error if these are provided, as an indication that they may support them in the future. Implementation -------------- Internally, the function opens a `MOM_netcdf_file`, generates its field/axis manifest, and reads the field contents. As with `MOM_read_data`, an internal rotation may be applied. The file is closed upon completion. (This behavior is designed to emulate the existing `MOM_read_data`; in a future implementation, we may want to use a persistent file handle which reduces the number of I/O operations.) Opening a `MOM_netcdf_file` now supports a `MOM_domain` argument, which is used to determine the index bounds of its local segment of the global domain. This is used to compute appropriate bounds for the native netCDF IO calls. As part of these changes, the `get_file_fields` function has been separated into itself and a new function, `update_file_contents`, which populates the internal axis and field metadata list. Usage ----- The following fields have been moved to the native netCDF IO: * `tideamp` (tidal mixing, FMS surface forcing) * `gustiness` (solo and FMS surface forcing) * `h2` (roughness in tidal mixing) This only comprises the fields which must be handled natively in order for the GFDL regression suite to pass with the PGI compiler; more files could be moved to native I/O in the future. Bugfixes -------- Some bugfixes to the netCDF I/O are also included: * `filename` attribute is now only written in an writeable state * Previously, `get_file_fields` (and now `update_file_contents`) assumed that every axis had an equivalent variable, which could lead to potential errors if an axis had no equvalent field, such as index bounds. We now count the number of variables with matching dimension names, tagged as axes, rather than assuming that every axis has a variable, and exclude them from the field list. * Not a bugfix, but `hor_index_init` was modified so that `param_file` is now an optional input. This function is used in `MOM_netcdf_file`, where `param_file` is not available. The argument is only used to call `log_param`. Previous usage of these functions was restricted to writing output with well-defined content, so were unaffected by these issues. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 12 +- .../solo_driver/MOM_surface_forcing.F90 | 7 +- src/framework/MOM_hor_index.F90 | 7 +- src/framework/MOM_io.F90 | 63 +++++++ src/framework/MOM_io_file.F90 | 155 ++++++++++++++++-- src/framework/MOM_netcdf.F90 | 60 +++++-- .../vertical/MOM_tidal_mixing.F90 | 11 +- 7 files changed, 279 insertions(+), 36 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 9a00f487e4..f732cb9a56 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -28,6 +28,7 @@ module MOM_surface_forcing_gfdl use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init use MOM_io, only : slasher, write_version_number, MOM_read_data +use MOM_io, only : read_netCDF_data use MOM_io, only : stdout_if_root use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state @@ -1507,7 +1508,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1, scale=US%m_to_Z*US%T_to_s) + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(TideAmp_file, 'tideamp', CS%TKE_tidal, G%Domain, & + rescale=US%m_to_Z*US%T_to_s) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) @@ -1537,8 +1541,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, & - scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(gust_file, 'gustiness', CS%gust, G%Domain, & + rescale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 04612b4138..74ed5c3023 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -30,6 +30,7 @@ module MOM_surface_forcing use MOM_grid, only : ocean_grid_type use MOM_get_input, only : Get_MOM_Input, directories use MOM_io, only : file_exists, MOM_read_data, MOM_read_vector, slasher +use MOM_io, only : read_netCDF_data use MOM_io, only : EAST_FACE, NORTH_FACE, num_timelevels use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state @@ -1866,8 +1867,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) filename = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(filename,'gustiness',CS%gust,G%domain, timelevel=1, & - scale=Pa_to_RLZ_T2) ! units in file should be Pa + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(filename, 'gustiness', CS%gust, G%Domain, & + rescale=Pa_to_RLZ_T2) ! units in file should be Pa endif ! All parameter settings are now known. diff --git a/src/framework/MOM_hor_index.F90 b/src/framework/MOM_hor_index.F90 index 4e8cb2c43b..2ce2808692 100644 --- a/src/framework/MOM_hor_index.F90 +++ b/src/framework/MOM_hor_index.F90 @@ -63,7 +63,7 @@ module MOM_hor_index subroutine hor_index_init(Domain, HI, param_file, local_indexing, index_offset) type(MOM_domain_type), intent(in) :: Domain !< The MOM domain from which to extract information. type(hor_index_type), intent(inout) :: HI !< A horizontal index type to populate with data - type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(param_file_type), optional, intent(in) :: param_file !< Parameter file handle logical, optional, intent(in) :: local_indexing !< If true, all tracer data domains start at 1 integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices @@ -80,8 +80,9 @@ subroutine hor_index_init(Domain, HI, param_file, local_indexing, index_offset) call get_global_shape(Domain, HI%niglobal, HI%njglobal) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, "MOM_hor_index", version, & - "Sets the horizontal array index types.", all_default=.true.) + if (present(param_file)) & + call log_version(param_file, "MOM_hor_index", version, & + "Sets the horizontal array index types.", all_default=.true.) HI%IscB = HI%isc ; HI%JscB = HI%jsc HI%IsdB = HI%isd ; HI%JsdB = HI%jsd diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 1dc6916c2c..3cc791dcda 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -61,6 +61,7 @@ module MOM_io public :: fieldtype, field_size, get_field_atts public :: axistype, get_axis_data public :: MOM_read_data, MOM_read_vector, read_field_chksum +public :: read_netCDF_data public :: slasher, write_version_number public :: io_infra_init, io_infra_end public :: stdout_if_root @@ -108,6 +109,15 @@ module MOM_io module procedure MOM_read_vector_3d end interface MOM_read_vector +!> Read a field using native netCDF I/O +!! +!! This function is primarily used for unstructured data which may contain +!! content that cannot be parsed by infrastructure I/O. +interface read_netCDF_data + ! NOTE: Only 2D I/O is currently used; this should be expanded as needed. + module procedure read_netCDF_data_2d +end interface read_netCDF_data + !> Write a registered field to an output file, potentially with rotation interface MOM_write_field module procedure MOM_write_field_legacy_4d @@ -2033,6 +2043,59 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & end subroutine MOM_read_data_2d +!> Read a 2d array from file using native netCDF I/O. +subroutine read_netCDF_data_2d(filename, fieldname, values, MOM_Domain, & + timelevel, position, rescale) + character(len=*), intent(in) :: filename + !< Input filename + character(len=*), intent(in) :: fieldname + !< Field variable name + real, intent(out) :: values(:,:) + !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain + !< Model domain decomposition + integer, optional, intent(in) :: timelevel + !< Time level to read in file + integer, optional, intent(in) :: position + !< Grid positioning flag + real, optional, intent(in) :: rescale + !< Rescale factor + + integer :: turns + ! Number of quarter-turns from input to model grid + real, allocatable :: values_in(:,:) + ! Field array on the unrotated input grid + type(MOM_netcdf_file) :: handle + ! netCDF file handle + + ! General-purpose IO will require the following arguments, but they are not + ! yet implemented, so we raise an error if they are present. + + ! Fields are currently assumed on cell centers, and position is unsupported + if (present(position)) & + call MOM_error(FATAL, 'read_netCDF_data: position is not yet supported.') + + ! Timelevels are not yet supported + if (present(timelevel)) & + call MOM_error(FATAL, 'read_netCDF_data: timelevel is not yet supported.') + + call handle%open(filename, action=READONLY_FILE, MOM_domain=MOM_domain) + call handle%update() + + turns = MOM_domain%turns + if (turns == 0) then + call handle%read(fieldname, values, rescale=rescale) + else + call allocate_rotated_array(values, [1,1], -turns, values_in) + call handle%read(fieldname, values_in, rescale=rescale) + call rotate_array(values_in, turns, values) + deallocate(values_in) + endif + + call handle%close() +end subroutine read_netCDF_data_2d + + !> Read a 2d region array from file using infrastructure I/O. subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & no_domain, scale, turns) diff --git a/src/framework/MOM_io_file.F90 b/src/framework/MOM_io_file.F90 index 68c0f33f07..0e60158093 100644 --- a/src/framework/MOM_io_file.F90 +++ b/src/framework/MOM_io_file.F90 @@ -15,6 +15,9 @@ module MOM_io_file use MOM_io_infra, only : get_field_atts use MOM_io_infra, only : read_field_chksum +use MOM_hor_index, only : hor_index_type +use MOM_hor_index, only : hor_index_init + use MOM_netcdf, only : netcdf_file_type use MOM_netcdf, only : netcdf_axis use MOM_netcdf, only : netcdf_field @@ -28,6 +31,7 @@ module MOM_io_file use MOM_netcdf, only : write_netcdf_attribute use MOM_netcdf, only : get_netcdf_size use MOM_netcdf, only : get_netcdf_fields +use MOM_netcdf, only : read_netcdf_field use MOM_error_handler, only : MOM_error, FATAL use MOM_error_handler, only : is_root_PE @@ -43,9 +47,9 @@ module MOM_io_file ! Internal types -! NOTE: MOM_axis and MOM_field do not represent the actual axes and -! fields stored in the file. They are only very thin wrappers to the keys (as -! strings) used to reference the associated object inside the MOM_file. +! NOTE: MOM_axis and MOM_field do not contain the actual axes and fields stored +! in the file. They are very thin wrappers to the keys (as strings) used to +! reference the associated object inside of the MOM_file. !> Handle for axis in MOM file type :: MOM_axis @@ -316,6 +320,10 @@ module MOM_io_file type(field_list_nc) :: fields !> True if the file has been opened logical :: is_open = .false. + !> True if I/O content is domain-decomposed + logical :: domain_decomposed = .false. + !> True if I/O content is domain-decomposed + type(hor_index_type) :: HI contains @@ -356,6 +364,12 @@ module MOM_io_file procedure :: get_field_atts => get_field_atts_nc !> Get checksum from a netCDF field procedure :: read_field_chksum => read_field_chksum_nc + + ! NOTE: These are currently exclusive to netCDF I/O but could be generalized + !> Read the values of a netCDF field + procedure :: read => get_field_nc + !> Update the axes and fields descriptors of a MOM netCDF file + procedure :: update => update_file_contents_nc end type MOM_netcdf_file @@ -1281,11 +1295,16 @@ subroutine open_file_nc(handle, filename, action, MOM_domain, threading, fileset integer, intent(in), optional :: threading integer, intent(in), optional :: fileset - if (.not. is_root_PE()) return + if (.not. present(MOM_domain) .and. .not. is_root_PE()) return call open_netcdf_file(handle%handle_nc, filename, action) - handle%is_open = .true. + + if (present(MOM_domain)) then + handle%domain_decomposed = .true. + call hor_index_init(MOM_domain, handle%HI) + endif + call handle%axes%init() call handle%fields%init() end subroutine open_file_nc @@ -1295,7 +1314,7 @@ end subroutine open_file_nc subroutine close_file_nc(handle) class(MOM_netcdf_file), intent(inout) :: handle - if (.not. is_root_PE()) return + if (.not. handle%domain_decomposed .and. .not. is_root_PE()) return handle%is_open = .false. call close_netcdf_file(handle%handle_nc) @@ -1575,31 +1594,56 @@ subroutine get_file_info_nc(handle, ndim, nvar, ntime) end subroutine get_file_info_nc -!> Return the field metadata associated with a MOM netCDF file -subroutine get_file_fields_nc(handle, fields) +!> Update the axes and fields descriptors of a MOM netCDF file +subroutine update_file_contents_nc(handle) class(MOM_netcdf_file), intent(inout) :: handle !< Handle for a file that is open for I/O - type(MOM_field), intent(inout) :: fields(:) - !< Field-type descriptions of all of the variables in a file. type(netcdf_axis), allocatable :: axes_nc(:) + ! netCDF axis descriptors type(netcdf_field), allocatable :: fields_nc(:) + ! netCDF field descriptors integer :: i + ! Index counter - if (.not. is_root_PE()) return + if (.not. handle%domain_decomposed .and. .not. is_root_PE()) return call get_netcdf_fields(handle%handle_nc, axes_nc, fields_nc) - if (size(fields) /= size(fields_nc)) & - call MOM_error(FATAL, 'Number of fields in file does not match field(:).') do i = 1, size(axes_nc) call handle%axes%append(axes_nc(i), axes_nc(i)%label) enddo - do i = 1, size(fields) - fields(i)%label = trim(fields_nc(i)%label) + do i = 1, size(fields_nc) call handle%fields%append(fields_nc(i), fields_nc(i)%label) enddo +end subroutine update_file_contents_nc + + +!> Return the field descriptors of a MOM netCDF file +subroutine get_file_fields_nc(handle, fields) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), intent(inout) :: fields(:) + !< Field-type descriptions of all of the variables in a file. + + type(field_node_nc), pointer :: node => null() + ! Current field list node + integer :: n + ! Field counter + + if (.not. is_root_PE()) return + + ! Generate the manifest of axes and fields + call handle%update() + + n = 0 + node => handle%fields%head + do while (associated(node%next)) + n = n + 1 + fields(n)%label = trim(node%label) + node => node%next + enddo end subroutine get_file_fields_nc @@ -1637,6 +1681,87 @@ subroutine read_field_chksum_nc(handle, field, chksum, valid_chksum) end subroutine read_field_chksum_nc +!> Read the values of a netCDF field +subroutine get_field_nc(handle, label, values, rescale) + class(MOM_netcdf_file), intent(in) :: handle + ! Handle of netCDF file to be read + character(len=*), intent(in) :: label + ! Field variable name + real, intent(out) :: values(:,:) + ! Field values read from file + real, optional, intent(in) :: rescale + + logical :: data_domain + ! True if values matches the data domain size + logical :: compute_domain + ! True if values matches the compute domain size + type(netcdf_field) :: field_nc + ! netCDF field associated with label + integer :: isc, iec, jsc, jec + ! Index bounds of compute domain + integer :: isd, ied, jsd, jed + ! Index bounds of data domain + integer :: bounds(2,2) + ! Index bounds of domain + real, allocatable :: values_nc(:,:) + ! Local copy of field, used for data-decomposed I/O + + isc = handle%HI%isc + iec = handle%HI%iec + jsc = handle%HI%jsc + jec = handle%HI%jec + + isd = handle%HI%isd + ied = handle%HI%ied + jsd = handle%HI%jsd + jed = handle%HI%jed + + data_domain = all(shape(values) == [ied-isd+1, jed-jsd+1]) + compute_domain = all(shape(values) == [iec-isc+1, jec-jsc+1]) + + ! NOTE: Data on face and vertex points is not yet supported. This is a + ! temporary check to detect such cases, but may be removed in the future. + if (.not. (compute_domain .or. data_domain)) & + call MOM_error(FATAL, 'get_field_nc: Only compute and data domains ' // & + 'are currently supported.') + + field_nc = handle%fields%get(label) + + if (data_domain) then + allocate(values_nc(isc:iec,jsc:jec)) + values(:,:) = 0. + endif + + if (handle%domain_decomposed) then + bounds(1,:) = [isc, jsc] + [handle%HI%idg_offset, handle%HI%jdg_offset] + bounds(2,:) = [iec, jec] + [handle%HI%idg_offset, handle%HI%jdg_offset] + if (data_domain) then + call read_netcdf_field(handle%handle_nc, field_nc, values_nc, bounds=bounds) + else + call read_netcdf_field(handle%handle_nc, field_nc, values, bounds=bounds) + endif + else + if (data_domain) then + call read_netcdf_field(handle%handle_nc, field_nc, values_nc) + else + call read_netcdf_field(handle%handle_nc, field_nc, values) + endif + endif + + if (data_domain) & + values(isc:iec,jsc:jec) = values_nc(:,:) + + ! NOTE: It is more efficient to do the rescale in-place while copying + ! values_nc(:,:) to values(:,:). But since rescale is only present for + ! debugging, we can probably disregard this impact on performance. + if (present(rescale)) then + if (rescale /= 1.0) then + values(isc:iec,jsc:jec) = rescale * values(isc:iec,jsc:jec) + endif + endif +end subroutine get_field_nc + + !> \namespace MOM_IO_file !! !! This file defines the MOM_file classes used to inferface with the internal diff --git a/src/framework/MOM_netcdf.F90 b/src/framework/MOM_netcdf.F90 index d09ae5cf95..54aad20c27 100644 --- a/src/framework/MOM_netcdf.F90 +++ b/src/framework/MOM_netcdf.F90 @@ -39,6 +39,7 @@ module MOM_netcdf public :: write_netcdf_attribute public :: get_netcdf_size public :: get_netcdf_fields +public :: read_netcdf_field !> Internal time value used to indicate an uninitialized time @@ -143,7 +144,8 @@ subroutine open_netcdf_file(handle, filename, mode) handle%filename = filename ! FMS writes the filename as an attribute - call write_netcdf_attribute(handle, 'filename', filename) + if (any(io_mode == [WRITEONLY_FILE, OVERWRITE_FILE])) & + call write_netcdf_attribute(handle, 'filename', filename) end subroutine open_netcdf_file @@ -606,13 +608,18 @@ end subroutine get_netcdf_size !> Get the metadata of the registered fields in a netCDF file subroutine get_netcdf_fields(handle, axes, fields) type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle type(netcdf_axis), intent(inout), allocatable :: axes(:) + !< netCDF file axes type(netcdf_field), intent(inout), allocatable :: fields(:) + !< netCDF file fields integer :: ndims ! Number of netCDF dimensions integer :: nvars ! Number of netCDF dimensions + type(netcdf_field), allocatable :: vars(:) + ! netCDF variables in handle integer :: nfields ! Number of fields in the file (i.e. non-axis variables) integer, allocatable :: dimids(:) @@ -656,13 +663,13 @@ subroutine get_netcdf_fields(handle, axes, fields) allocate(varids(nvars)) rc = nf90_inq_varids(handle%ncid, grp_nvars, varids) call check_netcdf_call(rc, 'get_netcdf_fields', & - 'File "' // handle%filename // '"') + 'File "' // trim(handle%filename) // '"') allocate(axes(ndims)) do i = 1, ndims rc = nf90_inquire_dimension(handle%ncid, dimids(i), name=label, len=len) call check_netcdf_call(rc, 'get_netcdf_fields', & - 'File "' // handle%filename // '"') + 'File "' // trim(handle%filename) // '"') ! Check for the unlimited axis if (dimids(i) == unlim_dimid) unlim_index = i @@ -672,14 +679,15 @@ subroutine get_netcdf_fields(handle, axes, fields) allocate(axes(i)%points(len)) enddo - nfields = nvars - ndims - allocate(fields(nfields)) + ! We cannot know if every axis also has a variable representation, so we + ! over-allocate vars(:) and fill as fields are identified. + allocate(vars(nvars)) - n = 0 + nfields = 0 do i = 1, nvars rc = nf90_inquire_variable(handle%ncid, varids(i), name=label) call check_netcdf_call(rc, 'get_netcdf_fields', & - 'File "' // handle%filename // '"') + 'File "' // trim(handle%filename) // '"') ! Check if variable is an axis is_axis = .false. @@ -687,7 +695,7 @@ subroutine get_netcdf_fields(handle, axes, fields) if (label == axes(j)%label) then rc = nf90_get_var(handle%ncid, varids(i), axes(j)%points) call check_netcdf_call(rc, 'get_netcdf_fields', & - 'File "' // handle%filename // '"') + 'File "' // trim(handle%filename) // '"') axes(j)%varid = varids(i) if (j == unlim_index) then @@ -702,13 +710,43 @@ subroutine get_netcdf_fields(handle, axes, fields) enddo if (is_axis) cycle - n = n + 1 - fields(n)%label = trim(label) - fields(n)%varid = varids(i) + nfields = nfields + 1 + vars(nfields)%label = trim(label) + vars(nfields)%varid = varids(i) enddo + + allocate(fields(nfields)) + fields(:) = vars(:nfields) end subroutine get_netcdf_fields +!> Read the values of a field from a netCDF file +subroutine read_netcdf_field(handle, field, values, bounds) + type(netcdf_file_type), intent(in) :: handle + type(netcdf_field), intent(in) :: field + real, intent(out) :: values(:,:) + integer, optional, intent(in) :: bounds(2,2) + + integer :: rc + ! netCDF return code + integer :: istart(2) + ! Axis start index + integer :: icount(2) + ! Axis index count + + if (present(bounds)) then + istart(:) = bounds(1,:) + icount(:) = bounds(2,:) - bounds(1,:) + 1 + rc = nf90_get_var(handle%ncid, field%varid, values, start=istart, count=icount) + else + rc = nf90_get_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'read_netcdf_field', & + 'File "' // trim(handle%filename) // '", Field "' // trim(field%label) // '"') +end subroutine read_netcdf_field + + +!> Set the current timestep of an open netCDF file subroutine update_netcdf_timestep(handle, time) type(netcdf_file_type), intent(inout) :: handle !< netCDF file handle diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 23b37bd26d..430a9225b5 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -11,6 +11,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, MOM_read_data, field_size +use MOM_io, only : read_netCDF_data use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_string_functions, only : uppercase, lowercase @@ -504,7 +505,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & "The name of the tidal amplitude variable in the input file.", & default="tideamp") - call MOM_read_data(filename, tideamp_var, CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(filename, tideamp_var, CS%tideamp, G%domain, & + rescale=US%m_to_Z*US%T_to_s) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -516,7 +520,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & "The name in the input file of the squared sub-grid-scale "//& "topographic roughness amplitude variable.", default="h2") - call MOM_read_data(filename, rough_var, CS%h2, G%domain, scale=US%m_to_Z**2) + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(filename, rough_var, CS%h2, G%domain, & + rescale=US%m_to_Z**2) call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& From 37b030a1800ced538cf6edacbb5cc15074f94f3e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 16 Feb 2023 07:55:02 -0500 Subject: [PATCH 185/213] Autoconf configuration of Python The introduction of makedep means that Python is now a dependency of the MOM6 compilation. On some systems, we cannot assume that `python` is the name of the interpreter, and strictly should not even assume that it exists. This is notably an issue on the recent MacOS M1 systems, which use `python3` as its interpreter, and do not provide one named `python`. This patch adds macros to the MOM6 and FMS autoconf builds to detect if Python is on the system, and makes a few attempts to determine the name of the interpreter (python, python3, python2). Perhaps more can be done here, but this is probably sufficient in nearly all cases. --- ac/Makefile.in | 3 ++- ac/configure.ac | 7 +++++++ ac/deps/Makefile.fms.in | 3 ++- ac/deps/configure.fms.ac | 9 ++++++++- 4 files changed, 19 insertions(+), 3 deletions(-) diff --git a/ac/Makefile.in b/ac/Makefile.in index 930816bc8c..43262027e6 100644 --- a/ac/Makefile.in +++ b/ac/Makefile.in @@ -6,6 +6,7 @@ FC = @FC@ LD = @FC@ +PYTHON = @PYTHON@ MAKEDEP = @MAKEDEP@ DEFS = @DEFS@ @@ -32,7 +33,7 @@ rwildcard=$(foreach d,$(wildcard $(1:=/*)),$(call rwildcard,$d,$2) $(filter $(su .PHONY: depend depend: Makefile.dep Makefile.dep: $(MAKEDEP) $(call rwildcard,$(SRC_DIRS),*.h *.c *.inc *.F90) - $(MAKEDEP) -o Makefile.dep -e $(SRC_DIRS) + $(PYTHON) $(MAKEDEP) -o Makefile.dep -e $(SRC_DIRS) # Delete any files associated with configuration (including the Makefile). diff --git a/ac/configure.ac b/ac/configure.ac index 049325a891..dead0579a6 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -221,6 +221,13 @@ AC_COMPILE_IFELSE( ) +# Verify that Python is available +AC_PATH_PROGS([PYTHON], [python python3 python2], [ + AC_MSG_ERROR([Could not find python.]) +]) +AC_ARG_VAR([PYTHON], [Python interpreter command]) + + # Verify that makedep is available AC_PATH_PROG([MAKEDEP], [makedep], [${srcdir}/ac/makedep]) AC_SUBST([MAKEDEP]) diff --git a/ac/deps/Makefile.fms.in b/ac/deps/Makefile.fms.in index e2581cf817..caf4abb9c7 100644 --- a/ac/deps/Makefile.fms.in +++ b/ac/deps/Makefile.fms.in @@ -8,6 +8,7 @@ CC = @CC@ FC = @FC@ LD = @FC@ AR = @AR@ +PYTHON = @PYTHON@ MAKEDEP = @MAKEDEP@ DEFS = @DEFS@ @@ -22,4 +23,4 @@ ARFLAGS = @ARFLAGS@ .PHONY: depend depend: Makefile.dep Makefile.dep: - $(MAKEDEP) -o Makefile.dep -e -x libFMS.a @srcdir@ + $(PYTHON) $(MAKEDEP) -o Makefile.dep -e -x libFMS.a @srcdir@ diff --git a/ac/deps/configure.fms.ac b/ac/deps/configure.fms.ac index 4e0c0f1390..a52533970b 100644 --- a/ac/deps/configure.fms.ac +++ b/ac/deps/configure.fms.ac @@ -158,7 +158,14 @@ AX_FC_ALLOW_ARG_MISMATCH FCFLAGS="$FCFLAGS $ALLOW_ARG_MISMATCH_FCFLAGS" -# Verify makedep +# Verify that Python is available +AC_PATH_PROGS([PYTHON], [python python3 python2], [ + AC_MSG_ERROR([Could not find python.]) +]) +AC_ARG_VAR([PYTHON], [Python interpreter command]) + + +# Verify that makedep is available AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) AS_IF([test -n "${MAKEDEP}"], [ AC_SUBST([MAKEDEP]) From 5f628582069cb6feee3b068dacbd5d2d0405a000 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 23 Feb 2023 10:16:16 -0500 Subject: [PATCH 186/213] reopen_MOM_file explicitly runs on root PE reopen_MOM_file includes an inquire test to determine whether we are attempting to reopen an existing file. If missing, it will attempt to create the missing file. The switch from FMS to netCDF I/O exposed a race condition here, where one rank may create the file, and another delayed rank may incorrectly identify this new file as already existing. This resulted in a segmentation fault. Unsure why this was not detected before; it could be that FMS was more resilient to the possibility of missing files. Regardless, the `exists` value was volatile and could lead to potential error. This patch introduces a temporary fix to the issue by checking the root PE and threading value. When threading is single-file, only the root PE participates in the existence test and file creation. This accounts for the case where either the root PE or any larger subset containing the root PE calls the function. It does not account for the more exotic case where a non-root PE many wish to create a file. If threading is set to MULTIPLE (i.e. IO domains) then an error is raised, since there's currently no safe way to implement an equivalent `inquire()` test. We can revisit this function when stronger controls around threaded IO are introduced. But for now, I believe that this is the best that we can do. --- src/framework/MOM_io.F90 | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 3cc791dcda..3e90ecd9b1 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -668,6 +668,20 @@ subroutine reopen_MOM_file(IO_handle, filename, vars, novars, fields, & thread = SINGLE_FILE if (PRESENT(threading)) thread = threading + ! For single-file IO, only the root PE is required to set up the fields. + ! This permits calls by either the root PE or all PEs + if (.not. is_root_PE() .and. thread == SINGLE_FILE) return + + ! For multiple IO domains, we would need additional functionality: + ! * Identify ranks as IO PEs + ! * Determine the filename of + ! Neither of these tasks should be handed by MOM6, so we cannot safely use + ! this function. A framework-specific `inquire()` function is needed. + ! Until it exists, we will disable this function. + if (thread == MULTIPLE) & + call MOM_error(FATAL, 'reopen_MOM_file does not yet support files with ' & + // 'multiple I/O domains.') + check_name = filename length = len(trim(check_name)) if (check_name(length-2:length) /= ".nc") check_name = trim(check_name)//".nc" From 6dc4de68611b9b3c4881b0c1f9ecd9ba5f254af1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 28 Feb 2023 13:05:29 -0500 Subject: [PATCH 187/213] GitLab: Extend run test timeouts Erratic slowdowns in our Lustre filesystem mean that test runtimes are largely unpredictable. This patch increases the runtimes from 20min to 1hr, to better cope with this issue. --- .gitlab-ci.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0462e3aa7a..653734097b 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -134,7 +134,7 @@ run:pgi: tags: - ncrc4 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite pgi SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite pgi SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-pgi-SNL || ( echo Batch job did not complete ; exit 911 ) run:intel: @@ -143,7 +143,7 @@ run:intel: tags: - ncrc4 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite intel SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite intel SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-intel-SNL || ( echo Batch job did not complete ; exit 911 ) run:gnu: @@ -152,7 +152,7 @@ run:gnu: tags: - ncrc4 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu SNLDT && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu SNLDT && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-SNLDT || ( echo Batch job did not complete ; exit 911 ) run:gnu-restarts: @@ -161,7 +161,7 @@ run:gnu-restarts: tags: - ncrc4 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu R && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu R && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-R || ( echo Batch job did not complete ; exit 911 ) # GH/autoconf tests (duplicates the GH actions tests) From 00854d054b229c0740c4c7606cc46a63cb5c012a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 Feb 2023 14:18:12 -0500 Subject: [PATCH 188/213] +Correct units in 1 get_param call and 64 comments Corrected the units in the get_param call for WAVE_HEIGHT_SCALE_FACTOR, and corrected the units descriptions in comments of 22 wind stress related variables in 6 driver routines, from [R L Z T-1 ~> Pa] to [R L Z T-2 ~> Pa], but the actual conversion factors in the code are correct. Also fixed 42 other inconsistent units in comments in 28 files scattered throughout the MOM6 code. WAVE_HEIGHT_SCALE_FACTOR was added in December 2022 as a part of PR #289 to dev/gfdl. These inconsistent units were detected because they do not match the patterns of other valid units; most are recent additions. Apart from a single unit in a get_param call, only comments are changed, and all answers are bitwise identical. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 4 +-- .../mct_cap/mom_surface_forcing_mct.F90 | 4 +-- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 4 +-- .../solo_driver/MESO_surface_forcing.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 26 +++++++++---------- .../solo_driver/user_surface_forcing.F90 | 6 ++--- .../drivers/unit_drivers/MOM_sum_driver.F90 | 2 +- src/ALE/MOM_hybgen_remap.F90 | 4 +-- src/core/MOM.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 2 +- src/core/MOM_forcing_type.F90 | 8 +++--- src/core/MOM_porous_barriers.F90 | 2 +- src/core/MOM_variables.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 4 +-- src/equation_of_state/MOM_EOS_linear.F90 | 2 +- src/framework/MOM_unit_scaling.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 26 +++++++++---------- .../MOM_state_initialization.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 2 +- .../lateral/MOM_thickness_diffuse.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 4 +-- .../vertical/MOM_kappa_shear.F90 | 2 +- .../vertical/MOM_opacity.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 4 +-- src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 4 +-- src/user/MOM_wave_interface.F90 | 4 +-- src/user/Rossby_front_2d_initialization.F90 | 2 +- src/user/tidal_bay_initialization.F90 | 2 +- 33 files changed, 70 insertions(+), 72 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index f732cb9a56..88d2cb3f42 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -83,14 +83,14 @@ module MOM_surface_forcing_gfdl !! type without any further adjustments to drive the ocean dynamics. !! The actual net mass source may differ due to corrections. - real :: gust_const !< Constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< Constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL() !< Turbulent kinetic energy introduced to the bottom boundary layer !! by drag on the tidal flows [R Z3 T-3 ~> W m-2]. real, pointer, dimension(:,:) :: & gust => NULL() !< A spatially varying unresolved background gustiness that - !! contributes to ustar [R L Z T-1 ~> Pa]. gust is used when read_gust_2d is true. + !! contributes to ustar [R L Z T-2 ~> Pa]. gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< Drag coefficient that applies to the tides [nondim] diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index b34f1a3b35..0364d46ddc 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -76,14 +76,14 @@ module MOM_surface_forcing_mct !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the !! bottom boundary layer by drag on the tidal flows [R Z3 T-3 ~> W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar [R L Z T-1 ~> Pa]. + !! gustiness that contributes to ustar [R L Z T-2 ~> Pa]. !! gust is used when read_gust_2d is true. ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index e2710bd18c..921d43d9b8 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -81,14 +81,14 @@ module MOM_surface_forcing_nuopc logical :: use_CFC !< enables the MOM_CFC_cap tracer package. logical :: enthalpy_cpl !< Controls if enthalpy terms are provided by the coupler or computed !! internally. - real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the !! bottom boundary layer by drag on the tidal flows [R Z3 T-3 ~> W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar [R L Z T-1 ~> Pa]. + !! gustiness that contributes to ustar [R L Z T-2 ~> Pa]. !! gust is used when read_gust_2d is true. ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 index 18c3c33fdb..12f1b6b78d 100644 --- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 @@ -31,7 +31,7 @@ module MESO_surface_forcing real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [R L Z T-1 ~> Pa] + !! that contributes to ustar [R L Z T-2 ~> Pa] real, dimension(:,:), pointer :: & T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward [C ~> degC]. S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward [S ~> ppt] diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 74ed5c3023..092bc9e513 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -85,13 +85,13 @@ module MOM_surface_forcing real :: latent_heat_fusion !< latent heat of fusion times [Q ~> J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1] real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" - !! forcing [R L Z T-1 ~> Pa] + !! forcing [R L Z T-2 ~> Pa] real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" - !! forcing [R L Z T-1 ~> Pa] + !! forcing [R L Z T-2 ~> Pa] - real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [R L Z T-1 ~> Pa] + real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [R L Z T-2 ~> Pa] !! gust is used when read_gust_2d is true. real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to [C ~> degC] @@ -102,9 +102,9 @@ module MOM_surface_forcing ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) - real :: gyres_taux_const !< A constant wind stress [R L Z T-1 ~> Pa]. - real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' - real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_const !< A constant wind stress [R L Z T-2 ~> Pa]. + real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-2 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-2 ~> Pa], if WIND_CONFIG=='gyres' real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' [nondim] integer :: answer_date !< This 8-digit integer gives the approximate date with which the order !! of arithmetic and expressions were added to the code. @@ -115,7 +115,7 @@ module MOM_surface_forcing !! gustless wind friction velocity. ! if WIND_CONFIG=='scurves' then use the following to define a piecewise scurve profile real :: scurves_ydata(20) = 90. !< Latitudes of scurve nodes [degreesN] - real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-1 ~> Pa] + real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-2 ~> Pa] real :: T_north !< Target temperatures at north used in buoyancy_forcing_linear [C ~> degC] real :: T_south !< Target temperatures at south used in buoyancy_forcing_linear [C ~> degC] @@ -392,7 +392,7 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) mag_tau = sqrt( tau_x0**2 + tau_y0**2) - ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. + ! Set the steady surface wind stresses, in units of [R L Z T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq forces%taux(I,j) = tau_x0 enddo ; enddo @@ -438,7 +438,7 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z PI = 4.0*atan(1.0) - ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. + ! Set the steady surface wind stresses, in units of [R L Z T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq forces%taux(I,j) = 0.1 * Pa_to_RLZ_T2 * & (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) @@ -513,7 +513,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) - ! steady surface wind stresses [R L Z T-1 ~> Pa] + ! steady surface wind stresses [R L Z T-2 ~> Pa] do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & @@ -670,8 +670,8 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables character(len=200) :: filename ! The name of the input file. - real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-1 ~> Pa] - real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-1 ~> Pa] + real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-2 ~> Pa] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-2 ~> Pa] real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: time_lev_daily ! The time levels to read for fields with diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90 index ae3f854335..fc803c27e6 100644 --- a/config_src/drivers/solo_driver/user_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/user_surface_forcing.F90 @@ -33,10 +33,10 @@ module user_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. - real :: G_Earth !< The gravitational acceleration [L2 Z-1 s-2 ~> m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [R L Z T-1 ~> Pa]. + !! that contributes to ustar [R L Z T-2 ~> Pa]. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -71,7 +71,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - ! Set the surface wind stresses, in units of [R L Z T-1 ~> Pa]. A positive taux + ! Set the surface wind stresses, in units of [R L Z T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index 0a6191b286..7a1ba82843 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -183,7 +183,7 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: D0 ! A constant to make the maximum ! basin depth MAXIMUM_DEPTH [m] - real :: m_to_Z ! A dimensional rescaling factor [m ~> Z] + real :: m_to_Z ! A dimensional rescaling factor [Z m-1 ~> 1] real :: x ! A fractional position in the x-direction [nondim] real :: y ! A fractional position in the y-direction [nondim] ! This include declares and sets the variable "version". diff --git a/src/ALE/MOM_hybgen_remap.F90 b/src/ALE/MOM_hybgen_remap.F90 index 213c6c677e..5ab3e162db 100644 --- a/src/ALE/MOM_hybgen_remap.F90 +++ b/src/ALE/MOM_hybgen_remap.F90 @@ -263,7 +263,7 @@ subroutine hybgen_weno_coefs(s, h_src, edges, nk, ns, thin, PCM_lay) ! real, parameter :: dsmll=1.0e-8 ! This has units of [A2], and hence can not be a parameter. ! real :: curv_cell ! An estimate of the tracer curvature centered on a cell times the grid - ! spacing [A H-1 ~> A m-1 or A kg m-2] + ! spacing [A H-1 ~> A m-1 or A m2 kg-1] real :: seh1, seh2 ! Tracer slopes at the cell edges times the cell grid spacing [A] real :: q01, q02 ! Various tracer differences between a cell average and the edge values [A] real :: q001, q002 ! Tracer slopes at the cell edges times the cell grid spacing [A] @@ -277,7 +277,7 @@ subroutine hybgen_weno_coefs(s, h_src, edges, nk, ns, thin, PCM_lay) ! concentrations and the left and right edges [A2] real :: min_ratio ! The minimum ratio of the values of zw used to interpolate the edge values [nondim] real :: wt1 ! The weight of the upper layer in the interpolated shared edge value [nondim] - real :: slope_edge(nk+1) ! Tracer slopes at the edges [A H-1 ~> A m-1 or A kg m-2] + real :: slope_edge(nk+1) ! Tracer slopes at the edges [A H-1 ~> A m-1 or A m2 kg-1] real :: val_edge(nk+1) ! A weighted average edge concentration [A] integer :: i, k diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 00e748bdc1..84eb5fc90a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1976,7 +1976,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real :: salin_underflow ! A tiny value of salinity below which the it is set to 0 [S ~> ppt] real :: temp_underflow ! A tiny magnitude of temperatures below which they are set to 0 [C ~> degC] real :: conv2watt ! A conversion factor from temperature fluxes to heat - ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] + ! fluxes [J m-2 H-1 C-1 ~> J m-3 degC-1 or J kg-1 degC-1] real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: S_flux_units diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 54eecd20c3..090d1ee0fb 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1044,7 +1044,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vh !< Volume flux through meridional - !! faces = v*h*dx [H L2 s-1 ~> m3 s-1 or kg s-1] + !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1] real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure.G diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index f005ac1a0e..9a5e1f48f5 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -969,7 +969,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netHeat ! net temp flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R C-1 ~> kg m-3 degC-1] real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R S-1 ~> kg m-3 ppt-1] @@ -996,7 +996,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] - ! netHeat = heat via surface fluxes [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! netHeat = heat via surface fluxes [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] ! netSalt = salt via surface fluxes [S H T-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux ! this call returns the rate because dt=1 (in arbitrary time units) @@ -1015,12 +1015,12 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt tv%eqn_of_state, EOS_domain(G%HI)) ! Adjust netSalt to reflect dilution effect of FW flux - ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + ! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 ) netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 4e812b65d7..ebe3907469 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -285,7 +285,7 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: eta_v !< Layer interface heights at v points [Z ~> m] ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m or 1/eta_to_m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m]. real :: h_neglect ! Negligible thicknesses [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 35cdf3038a..6aa94f584f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -101,7 +101,7 @@ module MOM_variables real, dimension(:,:), pointer :: salt_deficit => NULL() !< The salt needed to maintain the ocean column !! at a minimum salinity of MIN_SALINITY since the last time - !! that calculate_surface_state was called, [ppt R Z ~> gSalt m-2]. + !! that calculate_surface_state was called, [S R Z ~> gSalt m-2]. real, dimension(:,:), pointer :: TempxPmE => NULL() !< The net inflow of water into the ocean times the !! temperature at which this inflow occurs since the diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 12b87ebc64..4ddedf85a8 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -632,11 +632,11 @@ end subroutine calc_spec_vol_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale, scale_from_EOS) - real, intent(in) :: S !< Salinity, [ppt] or [Z ~> ppt] depending on scale_from_EOS + real, intent(in) :: S !< Salinity, [ppt] or [S ~> ppt] depending on scale_from_EOS real, intent(in) :: pressure !< Pressure, in [Pa] or [R L2 T-2 ~> Pa] depending on !! pres_scale or scale_from_EOS real, intent(out) :: T_fr !< Freezing point potential temperature referenced to the - !! surface [degC] or [degC ~> C] depending on scale_from_EOS + !! surface [degC] or [C ~> degC] depending on scale_from_EOS type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure !! into Pa [Pa T2 R-1 L-2 ~> 1]. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 07464861cb..dd45e6cd81 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -331,7 +331,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & intent(in) :: T !< Potential temperature relative to the surface !! [C ~> degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [S ?~> PSU]. + intent(in) :: S !< Salinity [S ~> PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index caf73ae8e1..bfc2189188 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -41,7 +41,7 @@ module MOM_unit_scaling real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1 [T m L-1 s-1 ~> 1] real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1 [L s T-1 m-1 ~> 1] real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2 [L s2 T-2 m-1 ~> 1] - real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T1 m2 Z-2 s-1 ~> 1] + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T m2 Z-2 s-1 ~> 1] real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1 [Z2 s T-1 m-2 ~> 1] real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1 [Q R Z m2 T-1 W-1 ~> 1] real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2 [W T Q-1 R-1 Z-1 m-2 ~> 1] diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 6691095b08..3049cae00c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -46,9 +46,9 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet !! on q-points (B grid) [L T-1 ~> m s-1] real, pointer, dimension(:,:) :: taudx_shelf => NULL() !< the driving stress of the ice shelf/sheet - !! on q-points (C grid) [Pa ~> Pa] + !! on q-points (C grid) [R L2 T-2 ~> Pa] real, pointer, dimension(:,:) :: taudy_shelf => NULL() !< the meridional stress of the ice shelf/sheet - !! on q-points (C grid) [Pa ~> Pa] + !! on q-points (C grid) [R L2 T-2 ~> Pa] real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, !! not vertices. Will represent boundary conditions on computational boundary @@ -147,7 +147,7 @@ module MOM_ice_shelf_dynamics logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. - real :: T_shelf_missing !< An ice shelf temperature to use where there is no ice shelf [degC ~> C] + real :: T_shelf_missing !< An ice shelf temperature to use where there is no ice shelf [C ~> degC] real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that !! determines when to stop the conjugate gradient iterations [nondim]. real :: nonlinear_tolerance !< The fractional nonlinear tolerance, relative to the initial error, @@ -235,7 +235,7 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables - real :: T_shelf_missing ! An ice shelf temperature to use where there is no ice shelf [degC ~> C] + real :: T_shelf_missing ! An ice shelf temperature to use where there is no ice shelf [C ~> degC] logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -696,10 +696,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - real, dimension(SZDIB_(G),SZDJB_(G)) ::taud_x,taud_y ! Pa] - real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc ! Pa s-1 m] - real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr ! Pa] + real, dimension(SZDIB_(G),SZDJB_(G)) :: taud_x, taud_y ! Pa] + real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc !< area-averaged vertically integrated ice viscosity + !! [R L2 Z T-1 ~> Pa s m] + real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr !< area-averaged basal traction [R L2 T-2 ~> Pa] integer :: iters logical :: update_ice_vel, coupled_GL @@ -1806,10 +1806,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: OD !< ocean floor depth at tracer points [Z ~> m]. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: taudx !< X-direction driving stress at q-points [kg L s-2 ~> kg m s-2] + intent(inout) :: taudx !< X-direction driving stress at q-points [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: taudy !< Y-direction driving stress at q-points [kg L s-2 ~> kg m s-2] - ! This will become [R L3 Z T-2 ~> kg m s-2] + intent(inout) :: taudy !< Y-direction driving stress at q-points [R L3 Z T-2 ~> kg m s-2] + ! driving stress! @@ -1827,7 +1827,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. - real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] @@ -3200,8 +3199,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH ! Integrated temperatures [C Z ~> degC m] integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: Tsurf ! Surface air temperature [C ~> degC]. This is hard coded but should be an input argument. - real :: adot ! A surface heat exchange coefficient divided by the heat capacity of - ! ice [R Z T-1 degC-1 ~> kg m-2 s-1 degC-1]. + real :: adot ! A surface heat exchange coefficient [R Z T-1 ~> kg m-2 s-1]. ! For now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0e50ebb67f..bd0931c694 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1192,7 +1192,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S_t, S_b ! Top and bottom edge values for reconstructions ! of salinity within each layer [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T_t, T_b ! Top and bottom edge values for reconstructions - ! of temperature within each layer [T ~> degC] + ! of temperature within each layer [C ~> degC] character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor ! A file-dependent scaling factor for the input pressure [various]. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 94f4468433..ffdf236152 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -813,7 +813,7 @@ real function growth_time(u_star, hBL, absf, h_neg, vonKar, Kv_rest, restrat_coe ! Local variables real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] - real :: Kv_eff ! An effective overall viscosity [Z1 T-1 ~> m2 s-1] + real :: Kv_eff ! An effective overall viscosity [Z2 T-1 ~> m2 s-1] real :: pi2 ! A scaling constant that is approximately pi^2 [nondim] ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + Kv_water diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 4e12aeeaad..a7ff2f1c0a 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -722,7 +722,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] + ! times unit conversion factors [L2 Z-2 T-2 ~> s-2] real :: Tl(5) ! copy of T in local stencil [C ~> degC] real :: mn_T ! mean of T in local stencil [C ~> degC] real :: mn_T2 ! mean of T**2 in local stencil [C2 ~> degC2] diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 5e530bea3d..66e2dfa6b2 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -912,7 +912,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: T !< Layer temperatures [C ~> degC]. real, dimension(SZI_(G),SZK0_(GV)), & - intent(in) :: S !< Layer salinities [C ~> ppt]. + intent(in) :: S !< Layer salinities [S ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. @@ -1890,7 +1890,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS ! Local variables real :: h_move ! The thickness of water being moved between layers [H ~> m or kg m-2] real :: h_tgt_old ! The previous thickness of the recipient layer [H ~> m or kg m-2] - real :: I_hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m3 kg-1] + real :: I_hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m2 kg-1] real :: dT_dS_wt2 ! The square of the relative weighting of temperature and salinity changes ! when extrapolating to match a target density [C2 S-2 ~> degC2 ppt-2] real :: dT_dR ! The ratio of temperature changes to density changes when diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 4e07b1d8ed..78ec0d9391 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -653,7 +653,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface [T-2 ~> s-2]. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] + ! velocity, and density equations [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers [nondim]. k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 43462131ca..77de5d13cd 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -38,7 +38,7 @@ module MOM_opacity !< The maximum wavelength in each band of penetrating shortwave radiation [nm] real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next - !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. + !! sufficiently thick layer [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]. real :: PenSW_absorb_Invlen !< The inverse of the thickness that is used to absorb the remaining !! shortwave heat flux when it drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]. integer :: answer_date !< The vintage of the order of arithmetic and expressions in the optics diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index bb159b2199..0dec7a40c0 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -900,7 +900,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real, dimension(SZI_(G)) :: & pres, & ! pressure at each interface [R L2 T-2 ~> Pa] - Temp_int, & ! temperature at each interface [C ~>degC] + Temp_int, & ! temperature at each interface [C ~> degC] Salin_int, & ! salinity at each interface [S ~> ppt] drho_bot, & ! A density difference [R ~> kg m-3] h_amp, & ! The topographic roughness amplitude [Z ~> m]. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 2a9e7deeba..1e3bf258d8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -287,7 +287,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: tmp ! A temporary variable, sometimes in [Z ~> m] real :: tmp_val_m1_to_p1 ! A temporary variable [nondim] real :: curv_tol ! Numerator of curvature cubed, used to estimate - ! accuracy of a single L(:) Newton iteration [H5 ~> m3 or kg5 m-10] + ! accuracy of a single L(:) Newton iteration [H5 ~> m5 or kg5 m-10] logical :: use_L0, do_one_L_iter ! Control flags for L(:) Newton iteration logical :: use_BBL_EOS, do_i(SZIB_(G)) integer, dimension(2) :: EOSdom ! The computational domain for the equation of state diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index d42355f245..7619cac2bd 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -777,9 +777,9 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array [ppt ~> S] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array [S ~> ppt] real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array [C ~> degC] - real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array [ppt ~> S] + real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array [S ~> ppt] integer :: i, j, k, is, ie, js, je, nz real, parameter :: fill_value = 0. diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index d887f5f3be..c089181c16 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -279,7 +279,7 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n intent(in) :: tr_in !< The z-space array of tracer concentrations !! that is read in [A] real, dimension(nk_data+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data - !! [Z ~> m or m] + !! [Z ~> m] or [m] integer, intent(in) :: nlay !< The number of vertical layers in the target grid real, dimension(SZI_(G),SZJ_(G),nlay+1), & intent(in) :: e !< The depths of the target layer interfaces [Z ~> m] or [m] diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 2244993447..fbc2b28a95 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -272,7 +272,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US !! fluxes can be applied [H ~> m or kg m-2] ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] integer :: i, j, k, is, ie, js, je, nz, m diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 36b157547f..20685d9711 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -363,7 +363,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then decay_timescale = (12.0 * (3.0**(-(tv%T(i,j,k)-20.0*US%degC_to_C)/10.0*US%degC_to_C))) * & - (86400.0*US%s_to_T) ! Timescale [s ~> T] + (86400.0*US%s_to_T) ! Timescale [T ~> s] ldecay = 1. / decay_timescale ! Rate [T-1 ~> s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*ldecay,0.)*CS%tr(i,j,k,m) endif diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 5be01bece4..d218b4ea80 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -270,8 +270,8 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec ! Accumulate the average anomalies for this period. dt_wt = wt_per1 * dt CS%avg_time(m_mid) = CS%avg_time(m_mid) + dt_wt - ! These loops temporarily change the units of the CS%avg_ variables to [degC T ~> degC s] - ! or [ppt T ~> ppt s]. + ! These loops temporarily change the units of the CS%avg_ variables to [C T ~> degC s] + ! or [S T ~> ppt s]. do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_mid) = CS%avg_SST_anom(i,j,m_mid) + & dt_wt * G%mask2dT(i,j) * SST_anom(i,j) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 723c8a0595..a548436329 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -198,7 +198,7 @@ module MOM_wave_interface real :: rho_air !< A typical density of air at sea level, as used in wave calculations [R ~> kg m-3] real :: nu_air !< The viscosity of air, as used in wave calculations [Z2 T-1 ~> m2 s-1] real :: SWH_from_u10sq !< A factor for converting the square of the 10 m wind speed to the - !! significant wave height [Z T2 L-2 ~> s m-2] + !! significant wave height [Z T2 L-2 ~> s2 m-1] real :: Charnock_min !< The minimum value of the Charnock coefficient, which relates the square of !! the air friction velocity divided by the gravitational acceleration to the !! wave roughness length [nondim] @@ -598,7 +598,7 @@ subroutine set_LF17_wave_params(param_file, mdl, US, CS) call get_param(param_file, mdl, "WAVE_HEIGHT_SCALE_FACTOR", CS%SWH_from_u10sq, & "A factor relating the square of the 10 m wind speed to the significant "//& "wave height, with a default value based on the Pierson-Moskowitz spectrum.", & - units="s m-2", default=0.0246, scale=US%m_to_Z*US%L_T_to_m_s**2) + units="s2 m-1", default=0.0246, scale=US%m_to_Z*US%L_T_to_m_s**2) call get_param(param_file, mdl, "CHARNOCK_MIN", CS%Charnock_min, & "The minimum value of the Charnock coefficient, which relates the square of "//& "the air friction velocity divided by the gravitational acceleration to the "//& diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index da18a7341c..9ff99b583f 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -122,7 +122,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & integer :: i, j, k, is, ie, js, je, nz real :: T_ref ! Reference temperature within the surface layer [C ~> degC] - real :: S_ref ! Reference salinity within the surface layer [S ~> [ppt] + real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] real :: T_range ! Range of temperatures over the vertical [C ~> degC] real :: zc ! Position of the middle of the cell [Z ~> m] real :: zi ! Bottom interface position relative to the sea surface [H ~> m or kg m-2] diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 60ce7b4a56..4a20f0e9b3 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -26,7 +26,7 @@ module tidal_bay_initialization !> Control structure for tidal bay open boundaries. type, public :: tidal_bay_OBC_CS ; private real :: tide_flow = 3.0e6 !< Maximum tidal flux with the tidal bay configuration [L2 Z T-1 ~> m3 s-1] - real :: tide_period !< The period associated with the tidal bay configuration [T ~> s-1] + real :: tide_period !< The period associated with the tidal bay configuration [T ~> s] real :: tide_ssh_amp !< The magnitude of the sea surface height anomalies at the inflow !! with the tidal bay configuration [Z ~> m] end type tidal_bay_OBC_CS From 348d7b741e124e2d51e5eaff90c30fedaa8628f5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 Feb 2023 18:00:14 -0500 Subject: [PATCH 189/213] (*)Fix a bug with BULKMIXEDLAYER & ML_MIX_FIRST>0 Restored an else that was inadvertently deleted as a part of code clean up in MOM-ocean/MOM6 PR #1127 on June 5, 2020. This bug causes bulkmixedlayer to be called twice (with cumulative effects) when 0. < ML_MIX_FIRST < 1., and not to be called at all when ML_MIX_FIRST = 1. This bug only applies to cases where the bulk mixed layer is enabled by setting BULKMIXEDLAYER=True and USE_REGRIDDING=False (i.e., in layered mode configurations with active thermodynamics), however because the default value of ML_MIX_FIRST = 0, this bug does not appear to be used in any active test cases, and it went undetected when it was introduced. All answers in the MOM6-examples test suite are bitwise identical, but this could change answers in some cases. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fa08a8c3af..44eed12295 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1783,6 +1783,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & eaml, ebml, G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & G, GV, US, CS%bulkmixedlayer, CS%optics, & From ceb4c9286df597a89977973b1f300ba1303765ee Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Feb 2023 14:38:48 -0500 Subject: [PATCH 190/213] Only root_PE makes write_energy netcdf file calls Revised write_energy so that only the root_PE attempts to open, reopen or write to a netcdf file. Although FMS can handle cases where multiple PEs make the same calls with internal logic, this change avoids requiring such internal (hidden) logical tests, and instead is more explicit on what is actually intended. This change is complementary to MOM6 dev/gfdl PR #328, which adds internal logic to handle the case where all PEs are making a call to reopen a single netcdf file. All answers and output are bitwise identical. --- src/diagnostics/MOM_sum_output.F90 | 76 +++++++++++++++--------------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 94f34a6c56..fd957d0a44 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -601,15 +601,15 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci endif endif endif - endif - energypath_nc = trim(CS%energyfile) // ".nc" - if (day > CS%Start_time) then - call reopen_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & - num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) - else - call create_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & - num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) + energypath_nc = trim(CS%energyfile) // ".nc" + if (day > CS%Start_time) then + call reopen_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & + num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) + else + call create_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & + num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) + endif endif endif @@ -795,7 +795,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci date_str = trim(mesg_intro)//trim(day_str) endif - if (is_root_pe()) then + if (is_root_pe()) then ! Only the root PE actually writes anything. if (CS%use_temperature) then write(stdout,'(A," ",A,": En ",ES12.6, ", MaxCFL ", F8.5, ", Mass ", & & ES18.12, ", Salt ", F15.11,", Temp ", F15.11)') & @@ -861,37 +861,37 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci enddo endif - endif - call CS%fileenergy_nc%write_field(CS%fields(1), real(CS%ntrunc), reday) - call CS%fileenergy_nc%write_field(CS%fields(2), toten, reday) - call CS%fileenergy_nc%write_field(CS%fields(3), PE, reday) - call CS%fileenergy_nc%write_field(CS%fields(4), KE, reday) - call CS%fileenergy_nc%write_field(CS%fields(5), H_0APE, reday) - call CS%fileenergy_nc%write_field(CS%fields(6), mass_lay, reday) - - call CS%fileenergy_nc%write_field(CS%fields(7), mass_tot, reday) - call CS%fileenergy_nc%write_field(CS%fields(8), mass_chg, reday) - call CS%fileenergy_nc%write_field(CS%fields(9), mass_anom, reday) - call CS%fileenergy_nc%write_field(CS%fields(10), max_CFL(1), reday) - call CS%fileenergy_nc%write_field(CS%fields(11), max_CFL(2), reday) - if (CS%use_temperature) then - call CS%fileenergy_nc%write_field(CS%fields(12), 0.001*Salt, reday) - call CS%fileenergy_nc%write_field(CS%fields(13), 0.001*salt_chg, reday) - call CS%fileenergy_nc%write_field(CS%fields(14), 0.001*salt_anom, reday) - call CS%fileenergy_nc%write_field(CS%fields(15), Heat, reday) - call CS%fileenergy_nc%write_field(CS%fields(16), heat_chg, reday) - call CS%fileenergy_nc%write_field(CS%fields(17), heat_anom, reday) - do m=1,nTr_stocks - call CS%fileenergy_nc%write_field(CS%fields(17+m), Tr_stocks(m), reday) - enddo - else - do m=1,nTr_stocks - call CS%fileenergy_nc%write_field(CS%fields(11+m), Tr_stocks(m), reday) - enddo - endif + call CS%fileenergy_nc%write_field(CS%fields(1), real(CS%ntrunc), reday) + call CS%fileenergy_nc%write_field(CS%fields(2), toten, reday) + call CS%fileenergy_nc%write_field(CS%fields(3), PE, reday) + call CS%fileenergy_nc%write_field(CS%fields(4), KE, reday) + call CS%fileenergy_nc%write_field(CS%fields(5), H_0APE, reday) + call CS%fileenergy_nc%write_field(CS%fields(6), mass_lay, reday) + + call CS%fileenergy_nc%write_field(CS%fields(7), mass_tot, reday) + call CS%fileenergy_nc%write_field(CS%fields(8), mass_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(9), mass_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(10), max_CFL(1), reday) + call CS%fileenergy_nc%write_field(CS%fields(11), max_CFL(2), reday) + if (CS%use_temperature) then + call CS%fileenergy_nc%write_field(CS%fields(12), 0.001*Salt, reday) + call CS%fileenergy_nc%write_field(CS%fields(13), 0.001*salt_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(14), 0.001*salt_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(15), Heat, reday) + call CS%fileenergy_nc%write_field(CS%fields(16), heat_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(17), heat_anom, reday) + do m=1,nTr_stocks + call CS%fileenergy_nc%write_field(CS%fields(17+m), Tr_stocks(m), reday) + enddo + else + do m=1,nTr_stocks + call CS%fileenergy_nc%write_field(CS%fields(11+m), Tr_stocks(m), reday) + enddo + endif - call CS%fileenergy_nc%flush() + call CS%fileenergy_nc%flush() + endif ! Only the root PE actually writes anything. if (is_NaN(En_mass)) then call MOM_error(FATAL, "write_energy : NaNs in total model energy forced model termination.") From 37389b5ab832c215df4cdd5a5e23753691980e34 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 26 Mar 2023 13:38:00 -0400 Subject: [PATCH 191/213] Fix indexing bugs in get_field_nc (#334) Fixed two horizontal indexing bugs in `get_field_nc`, where the difference between the array starting index (always 1 in this subroutine) and the values in the handle argument were not being taken into account when the array was being passed in with only its computational domain. Also initialized the internal `unlim_index` array in `get_netcdf_fields` to fix a problem with using an uninitialized array that was being flagged when run in debug mode. With this commit, the model is once again reproducing the expected answers when rescaling is applied for vertical distances or time. Co-authored-by: Marshall Ward --- src/framework/MOM_io.F90 | 9 ++++--- src/framework/MOM_io_file.F90 | 48 ++++++++++++++++++++++------------- src/framework/MOM_netcdf.F90 | 3 +++ 3 files changed, 39 insertions(+), 21 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 3e90ecd9b1..1026216426 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -2057,15 +2057,16 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & end subroutine MOM_read_data_2d -!> Read a 2d array from file using native netCDF I/O. +!> Read a 2d array (which might have halos) from a file using native netCDF I/O. subroutine read_netCDF_data_2d(filename, fieldname, values, MOM_Domain, & timelevel, position, rescale) character(len=*), intent(in) :: filename !< Input filename character(len=*), intent(in) :: fieldname !< Field variable name - real, intent(out) :: values(:,:) - !< Field value + real, intent(inout) :: values(:,:) + !< Field values read from the file. It would be intent(out) but for the + !! need to preserve any initialized values in the halo regions. type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition integer, optional, intent(in) :: timelevel @@ -2073,7 +2074,7 @@ subroutine read_netCDF_data_2d(filename, fieldname, values, MOM_Domain, & integer, optional, intent(in) :: position !< Grid positioning flag real, optional, intent(in) :: rescale - !< Rescale factor + !< Rescale factor, omitting this is the same as setting it to 1. integer :: turns ! Number of quarter-turns from input to model grid diff --git a/src/framework/MOM_io_file.F90 b/src/framework/MOM_io_file.F90 index 0e60158093..e1613fbbb3 100644 --- a/src/framework/MOM_io_file.F90 +++ b/src/framework/MOM_io_file.F90 @@ -1681,15 +1681,18 @@ subroutine read_field_chksum_nc(handle, field, chksum, valid_chksum) end subroutine read_field_chksum_nc -!> Read the values of a netCDF field +!> Read the values of a netCDF field into an array that might have halos subroutine get_field_nc(handle, label, values, rescale) class(MOM_netcdf_file), intent(in) :: handle - ! Handle of netCDF file to be read + !< Handle of netCDF file to be read character(len=*), intent(in) :: label - ! Field variable name - real, intent(out) :: values(:,:) - ! Field values read from file + !< Field variable name + real, intent(inout) :: values(:,:) + !< Field values read from the file. It would be intent(out) but for the + !! need to preserve any initialized values in the halo regions. real, optional, intent(in) :: rescale + !< A multiplicative rescaling factor for the values that are read. + !! Omitting this is the same as setting it to 1. logical :: data_domain ! True if values matches the data domain size @@ -1701,10 +1704,12 @@ subroutine get_field_nc(handle, label, values, rescale) ! Index bounds of compute domain integer :: isd, ied, jsd, jed ! Index bounds of data domain + integer :: iscl, iecl, jscl, jecl + ! Local 1-based index bounds of compute domain integer :: bounds(2,2) ! Index bounds of domain - real, allocatable :: values_nc(:,:) - ! Local copy of field, used for data-decomposed I/O + real, allocatable :: values_c(:,:) + ! Field values on the compute domain, used for copying to a data domain isc = handle%HI%isc iec = handle%HI%iec @@ -1727,36 +1732,45 @@ subroutine get_field_nc(handle, label, values, rescale) field_nc = handle%fields%get(label) - if (data_domain) then - allocate(values_nc(isc:iec,jsc:jec)) - values(:,:) = 0. - endif + if (data_domain) & + allocate(values_c(1:iec-isc+1,1:jec-jsc+1)) if (handle%domain_decomposed) then bounds(1,:) = [isc, jsc] + [handle%HI%idg_offset, handle%HI%jdg_offset] bounds(2,:) = [iec, jec] + [handle%HI%idg_offset, handle%HI%jdg_offset] if (data_domain) then - call read_netcdf_field(handle%handle_nc, field_nc, values_nc, bounds=bounds) + call read_netcdf_field(handle%handle_nc, field_nc, values_c, bounds=bounds) else call read_netcdf_field(handle%handle_nc, field_nc, values, bounds=bounds) endif else if (data_domain) then - call read_netcdf_field(handle%handle_nc, field_nc, values_nc) + call read_netcdf_field(handle%handle_nc, field_nc, values_c) else call read_netcdf_field(handle%handle_nc, field_nc, values) endif endif - if (data_domain) & - values(isc:iec,jsc:jec) = values_nc(:,:) + if (data_domain) then + iscl = isc - isd + 1 + iecl = iec - isd + 1 + jscl = jsc - jsd + 1 + jecl = jec - jsd + 1 + + values(iscl:iecl,jscl:jecl) = values_c(:,:) + else + iscl = 1 + iecl = iec - isc + 1 + jscl = 1 + jecl = jec - jsc + 1 + endif ! NOTE: It is more efficient to do the rescale in-place while copying - ! values_nc(:,:) to values(:,:). But since rescale is only present for + ! values_c(:,:) to values(:,:). But since rescale is only present for ! debugging, we can probably disregard this impact on performance. if (present(rescale)) then if (rescale /= 1.0) then - values(isc:iec,jsc:jec) = rescale * values(isc:iec,jsc:jec) + values(iscl:iecl,jscl:jecl) = rescale * values(iscl:iecl,jscl:jecl) endif endif end subroutine get_field_nc diff --git a/src/framework/MOM_netcdf.F90 b/src/framework/MOM_netcdf.F90 index 54aad20c27..95e6aa7bb7 100644 --- a/src/framework/MOM_netcdf.F90 +++ b/src/framework/MOM_netcdf.F90 @@ -665,6 +665,9 @@ subroutine get_netcdf_fields(handle, axes, fields) call check_netcdf_call(rc, 'get_netcdf_fields', & 'File "' // trim(handle%filename) // '"') + ! Initialize unlim_index with an unreachable value (outside [1,ndims]) + unlim_index = -1 + allocate(axes(ndims)) do i = 1, ndims rc = nf90_inquire_dimension(handle%ncid, dimids(i), name=label, len=len) From 588cf03adeed355e3db9a12a73c726f3b88b4c35 Mon Sep 17 00:00:00 2001 From: "Alan J. Wallcraft" Date: Sun, 19 Mar 2023 16:37:44 +0000 Subject: [PATCH 192/213] Add PPM_CM and HYCOM1_ONLY_IMPROVES Add "PPM_CW" as an option for INTERPOLATION_SCHEME and REMAPPING_SCHEME. This implements the original Colella and Woodward (1984) edge calculation for PPM. It computes 4th order explicit edge values but constrains them to produce a monotonic profile, which is particularly effective for remapping. INTERPOLATION_SCHEME="PPM_CW" is identical to "REMAPPING_PPM_HYBGEN", but hybgen_PPM_coefs has been replaced by edge_values_explicit_h4cw and PPM_monotonicity for flexibility and to simplify upgrades. Answers with existing INTERPOLATION_SCHEME options are unchanged. REMAPPING_SCHEME="PPM_CW" is a new option which can perform better than "P1M_H2" when used with INTERPOLATION_SCHEME="PPM_CW". Answers with existing REMAPPING_SCHEME options are unchanged. HYCOM1 regridding walks a monotonic density profile to locate the new interface locations where the interface density equals the target density. However, it assumes that moving one interface has no effect on the density at all other interfaces and this need not be the case. When regridding, with HYCOM1_ONLY_IMPROVES=True, an interface is only moved if this improves the fit to its target density. The default of False does not change answers. --- src/ALE/MOM_ALE.F90 | 4 +- src/ALE/MOM_regridding.F90 | 17 +++-- src/ALE/MOM_remapping.F90 | 17 ++++- src/ALE/PPM_functions.F90 | 31 ++++++++- src/ALE/coord_hycom.F90 | 122 +++++++++++++++++++++++++++++---- src/ALE/regrid_edge_values.F90 | 102 ++++++++++++++++++++++++++- src/ALE/regrid_interp.F90 | 27 +++++++- 7 files changed, 297 insertions(+), 23 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 2a9ebc09c8..137f6cee9b 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -206,12 +206,12 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call get_param(param_file, mdl, "REMAPPING_SCHEME", string, & "This sets the reconstruction scheme used "//& "for vertical remapping for all variables. "//& - "It can be one of the following schemes: "//& + "It can be one of the following schemes: \n"//& trim(remappingSchemesDoc), default=remappingDefaultScheme) call get_param(param_file, mdl, "VELOCITY_REMAPPING_SCHEME", vel_string, & "This sets the reconstruction scheme used for vertical remapping "//& "of velocities. By default it is the same as REMAPPING_SCHEME. "//& - "It can be one of the following schemes: "//& + "It can be one of the following schemes: \n"//& trim(remappingSchemesDoc), default=trim(string)) call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & "If true, cell-by-cell reconstructions are checked for "//& diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 53072909a5..5e46b8d1f6 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -166,6 +166,7 @@ module MOM_regridding " P1M_H4 (2nd-order accurate)\n"//& " P1M_IH4 (2nd-order accurate)\n"//& " PLM (2nd-order accurate)\n"//& + " PPM_CW (3rd-order accurate)\n"//& " PPM_H4 (3rd-order accurate)\n"//& " PPM_IH4 (3rd-order accurate)\n"//& " P3M_IH4IH3 (4th-order accurate)\n"//& @@ -269,7 +270,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m "determine the new grid. These parameters are "//& "only relevant when REGRIDDING_COORDINATE_MODE is "//& "set to a function of state. Otherwise, it is not "//& - "used. It can be one of the following schemes: "//& + "used. It can be one of the following schemes: \n"//& trim(regriddingInterpSchemeDoc), default=trim(string2)) call set_regrid_params(CS, interp_scheme=string) @@ -582,6 +583,13 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call set_regrid_params(CS, min_thickness=0.) endif + if (main_parameters .and. coordinateMode(coord_mode) == REGRIDDING_HYCOM1) then + call get_param(param_file, mdl, "HYCOM1_ONLY_IMPROVES", tmpLogical, & + "When regridding, an interface is only moved if this improves the fit to the target density.", & + default=.false.) + call set_hycom_params(CS%hycom_CS, only_improves=tmpLogical) + endif + CS%use_hybgen_unmix = .false. if (coordinateMode(coord_mode) == REGRIDDING_HYBGEN) then call get_param(param_file, mdl, "USE_HYBGEN_UNMIX", CS%use_hybgen_unmix, & @@ -865,7 +873,7 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, & call build_grid_arbitrary( G, GV, h, dzInterface, trickGnuCompiler, CS ) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_HYCOM1 ) - call build_grid_HyCOM1( G, GV, G%US, h, tv, h_new, dzInterface, CS, frac_shelf_h ) + call build_grid_HyCOM1( G, GV, G%US, h, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h ) case ( REGRIDDING_HYBGEN ) call hybgen_regrid(G, GV, G%US, h, tv, CS%hybgen_CS, dzInterface, PCM_cell) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) @@ -1515,12 +1523,13 @@ end subroutine build_rho_grid !! \remark { Based on Bleck, 2002: An ocean-ice general circulation model framed in !! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88. !! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 } -subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_shelf_h ) +subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h ) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position @@ -1575,7 +1584,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she ( 0.5 * ( z_col(K) + z_col(K+1) ) * (GV%H_to_RZ*GV%g_Earth) - tv%P_Ref ) enddo - call build_hycom1_column(CS%hycom_CS, tv%eqn_of_state, GV%ke, nominalDepth, & + call build_hycom1_column(CS%hycom_CS, remapCS, tv%eqn_of_state, GV%ke, nominalDepth, & h(i,j,:), tv%T(i,j,:), tv%S(i,j,:), p_col, & z_col, z_col_new, zScale=GV%Z_to_H, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 9ebc0601d2..eeb4590a08 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -8,12 +8,14 @@ module MOM_remapping use MOM_io, only : stdout, stderr use MOM_string_functions, only : uppercase use regrid_edge_values, only : edge_values_explicit_h4, edge_values_implicit_h4 +use regrid_edge_values, only : edge_values_explicit_h4cw use regrid_edge_values, only : edge_values_implicit_h4, edge_values_implicit_h6 use regrid_edge_values, only : edge_slopes_implicit_h3, edge_slopes_implicit_h5 use remapping_attic, only : remapping_attic_unit_tests use PCM_functions, only : PCM_reconstruction use PLM_functions, only : PLM_reconstruction, PLM_boundary_extrapolation use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use PPM_functions, only : PPM_monotonicity use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 use MOM_hybgen_remap, only : hybgen_plm_coefs, hybgen_ppm_coefs, hybgen_weno_coefs @@ -48,6 +50,7 @@ module MOM_remapping integer, parameter :: REMAPPING_PCM = 0 !< O(h^1) remapping scheme integer, parameter :: REMAPPING_PLM = 2 !< O(h^2) remapping scheme integer, parameter :: REMAPPING_PLM_HYBGEN = 3 !< O(h^2) remapping scheme +integer, parameter :: REMAPPING_PPM_CW =10 !< O(h^3) remapping scheme integer, parameter :: REMAPPING_PPM_H4 = 4 !< O(h^3) remapping scheme integer, parameter :: REMAPPING_PPM_IH4 = 5 !< O(h^3) remapping scheme integer, parameter :: REMAPPING_PPM_HYBGEN = 6 !< O(h^3) remapping scheme @@ -287,7 +290,7 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & local_remapping_scheme = REMAPPING_PCM elseif (n0<=3) then local_remapping_scheme = min( local_remapping_scheme, REMAPPING_PLM ) - elseif (n0<=4) then + elseif (n0<=4 .and. local_remapping_scheme /= REMAPPING_PPM_CW ) then local_remapping_scheme = min( local_remapping_scheme, REMAPPING_PPM_H4 ) endif select case ( local_remapping_scheme ) @@ -310,6 +313,15 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & if ( CS%boundary_extrapolation ) & call PLM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) iMethod = INTEGRATION_PLM + case ( REMAPPING_PPM_CW ) + ! identical to REMAPPING_PPM_HYBGEN + call edge_values_explicit_h4cw( n0, h0, u0, ppoly_r_E, h_neglect_edge ) + call PPM_monotonicity( n0, u0, ppoly_r_E ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=CS%answer_date ) + if ( CS%boundary_extrapolation ) then + call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) + endif + iMethod = INTEGRATION_PPM case ( REMAPPING_PPM_H4 ) call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answer_date=CS%answer_date ) call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=CS%answer_date ) @@ -1283,6 +1295,9 @@ subroutine setReconstructionType(string,CS) case ("PLM_HYBGEN") CS%remapping_scheme = REMAPPING_PLM_HYBGEN degree = 1 + case ("PPM_CW") + CS%remapping_scheme = REMAPPING_PPM_CW + degree = 2 case ("PPM_H4") CS%remapping_scheme = REMAPPING_PPM_H4 degree = 2 diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index aa24806d68..805a70d502 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -13,7 +13,7 @@ module PPM_functions implicit none ; private -public PPM_reconstruction, PPM_boundary_extrapolation +public PPM_reconstruction, PPM_boundary_extrapolation, PPM_monotonicity !> A tiny width that is so small that adding it to cell widths does not !! change the value due to a computational representation. It is used @@ -127,6 +127,35 @@ subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answer_date ) end subroutine PPM_limiter_standard +!> Adjusts edge values using the original monotonicity constraint (Colella & Woodward, JCP 1984) +!! Based on hybgen_ppm_coefs +subroutine PPM_monotonicity( N, u, edge_values ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] + real, dimension(:,:), intent(inout) :: edge_values !< Potentially modified edge values [A] + + ! Local variables + integer :: k ! Loop index + real :: a6,da ! scalar temporaries + + ! Loop on interior cells to impose monotonicity + ! Eq. 1.10 of (Colella & Woodward, JCP 84) + do k = 2,N-1 + if (((u(k+1)-u(k))*(u(k)-u(k-1)) <= 0.)) then !local extremum + edge_values(k,1) = u(k) + edge_values(k,2) = u(k) + else + da = edge_values(k,2)-edge_values(k,1) + a6 = 6.0*u(k) - 3.0*(edge_values(k,1)+edge_values(k,2)) + if (da*a6 > da*da) then !peak in right half of zone + edge_values(k,1) = 3.0*u(k) - 2.0*edge_values(k,2) + elseif (da*a6 < -da*da) then !peak in left half of zone + edge_values(k,2) = 3.0*u(k) - 2.0*edge_values(k,1) + endif + endif + enddo ! end loop on interior cells + +end subroutine PPM_monotonicity !------------------------------------------------------------------------------ !> Reconstruction by parabolas within boundary cells diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 5a3ffaff52..aa2715eb42 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -4,8 +4,10 @@ module coord_hycom ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL +use MOM_remapping, only : remapping_CS, remapping_core_h use MOM_EOS, only : EOS_type, calculate_density -use regrid_interp, only : interp_CS_type, build_and_interpolate_grid +use regrid_interp, only : interp_CS_type, build_and_interpolate_grid, regridding_set_ppolys +use regrid_interp, only : DEGREE_MAX implicit none ; private @@ -27,6 +29,9 @@ module coord_hycom !> Maximum thicknesses of layers [H ~> m or kg m-2] real, allocatable, dimension(:) :: max_layer_thickness + !> If true, an interface only moves if it improves the density fit + logical :: only_improves = .false. + !> Interpolation control structure type(interp_CS_type) :: interp_CS end type hycom_CS @@ -69,10 +74,11 @@ subroutine end_coord_hycom(CS) end subroutine end_coord_hycom !> This subroutine can be used to set the parameters for the coord_hycom module -subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS) +subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, only_improves, interp_CS) type(hycom_CS), pointer :: CS !< Coordinate control structure real, dimension(:), optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] real, dimension(:), optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] + logical, optional, intent(in) :: only_improves !< If true, an interface only moves if it improves the density fit type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation if (.not. associated(CS)) call MOM_error(FATAL, "set_hycom_params: CS not associated") @@ -91,13 +97,16 @@ subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, inter CS%max_layer_thickness(:) = max_layer_thickness(:) endif + if (present(only_improves)) CS%only_improves = only_improves + if (present(interp_CS)) CS%interp_CS = interp_CS end subroutine set_hycom_params !> Build a HyCOM coordinate column -subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & +subroutine build_hycom1_column(CS, remapCS, eqn_of_state, nz, depth, h, T, S, p_col, & z_col, z_col_new, zScale, h_neglect, h_neglect_edge) type(hycom_CS), intent(in) :: CS !< Coordinate control structure + type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) @@ -116,8 +125,17 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & ! Local variables integer :: k - real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] - real, dimension(CS%nk) :: h_col_new ! New layer thicknesses + real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] + real, dimension(CS%nk) :: h_col_new ! New layer thicknesses [H ~> m or kg m-2] + real, dimension(CS%nk) :: r_col_new ! New layer densities [R ~> kg m-3] + real, dimension(CS%nk) :: T_col_new ! New layer temperatures [C ~> degC] + real, dimension(CS%nk) :: S_col_new ! New layer salinities [S ~> ppt] + real, dimension(CS%nk) :: p_col_new ! New layer pressure [R L2 T-2 ~> Pa] + real, dimension(CS%nk+1) :: RiA_ini ! Initial nk+1 interface density anomaly w.r.t. the + ! interface target densities [R ~> kg m-3] + real, dimension(CS%nk+1) :: RiA_new ! New interface density anomaly w.r.t. the + ! interface target densities [R ~> kg m-3] + real :: z_1, z_nz ! mid point of 1st and last layers [H ~> m or kg m-2] real :: z_scale ! A scaling factor from the input thicknesses to the target thicknesses, ! perhaps 1 or a factor in [H Z-1 ~> 1 or kg m-3] real :: stretching ! z* stretching, converts z* to z [nondim]. @@ -130,18 +148,43 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_scale = 1.0 ; if (present(zScale)) z_scale = zScale - ! Work bottom recording potential density - call calculate_density(T, S, p_col, rho_col, eqn_of_state) - ! This ensures the potential density profile is monotonic - ! although not necessarily single valued. - do k = nz-1, 1, -1 - rho_col(k) = min( rho_col(k), rho_col(k+1) ) - enddo + if (CS%only_improves .and. nz == CS%nk) then + call build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, CS%nk, depth, & + h, T, S, p_col, rho_col, RiA_ini, h_neglect, h_neglect_edge) + else + ! Work bottom recording potential density + call calculate_density(T, S, p_col, rho_col, eqn_of_state) + ! This ensures the potential density profile is monotonic + ! although not necessarily single valued. + do k = nz-1, 1, -1 + rho_col(k) = min( rho_col(k), rho_col(k+1) ) + enddo + endif ! Interpolates for the target interface position with the rho_col profile ! Based on global density profile, interpolate to generate a new grid call build_and_interpolate_grid(CS%interp_CS, rho_col, nz, h(:), z_col, & CS%target_density, CS%nk, h_col_new, z_col_new, h_neglect, h_neglect_edge) + if (CS%only_improves .and. nz == CS%nk) then + ! Only move an interface if it improves the density fit + z_1 = 0.5 * ( z_col(1) + z_col(2) ) + z_nz = 0.5 * ( z_col(nz) + z_col(nz+1) ) + do k = 1,CS%nk + p_col_new(k) = p_col(1) + ( 0.5 * ( z_col_new(K) + z_col_new(K+1) ) - z_1 ) / ( z_nz - z_1 ) * & + ( p_col(nz) - p_col(1) ) + enddo + ! Remap from original h and T,S to get T,S_col_new + call remapping_core_h(remapCS, nz, h(:), T, CS%nk, h_col_new, T_col_new, h_neglect, h_neglect_edge) + call remapping_core_h(remapCS, nz, h(:), S, CS%nk, h_col_new, S_col_new, h_neglect, h_neglect_edge) + call build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, CS%nk, depth, & + h_col_new, T_col_new, S_col_new, p_col_new, r_col_new, RiA_new, h_neglect, h_neglect_edge) + do k= 2,CS%nk + if ( abs(RiA_ini(K)) <= abs(RiA_new(K)) .and. z_col(K) > z_col_new(K-1) .and. & + z_col(K) < z_col_new(K+1)) then + z_col_new(K) = z_col(K) + endif + enddo + endif !only_improves ! Sweep down the interfaces and make sure that the interface is at least ! as deep as a nominal target z* grid @@ -165,4 +208,59 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & enddo ; endif end subroutine build_hycom1_column +!> Calculate interface density anomaly w.r.t. the target. +subroutine build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, nz, depth, h, T, S, p_col, & + R, RiAnom, h_neglect, h_neglect_edge) + type(hycom_CS), intent(in) :: CS !< Coordinate control structure + type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure + integer, intent(in) :: nz !< Number of levels + real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) + real, dimension(nz), intent(in) :: T !< Temperature of column [C ~> degC] + real, dimension(nz), intent(in) :: S !< Salinity of column [S ~> ppt] + real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(nz), intent(in) :: p_col !< Layer pressure [R L2 T-2 ~> Pa] + !! to desired units for zInterface, perhaps GV%Z_to_H. + real, dimension(nz), intent(out) :: R !< Layer density [R ~> kg m-3] + real, dimension(nz+1), intent(out) :: RiAnom !< The interface density anomaly + !! w.r.t. the interface target + !! densities [R ~> kg m-3] + real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of + !! cell reconstruction [H ~> m or kg m-2] + real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose of + !! edge value calculation [H ~> m or kg m-2] + ! Local variables + integer :: degree,k + real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] + real, dimension(nz,2) :: ppoly_E ! Polynomial edge values [R ~> kg m-3] + real, dimension(nz,2) :: ppoly_S ! Polynomial edge slopes [R H-1] + real, dimension(nz,DEGREE_MAX+1) :: ppoly_C ! Polynomial interpolant coeficients on the local 0-1 grid [R ~> kg m-3] + + ! Work bottom recording potential density + call calculate_density(T, S, p_col, rho_col, eqn_of_state) + ! This ensures the potential density profile is monotonic + ! although not necessarily single valued. + do k = nz-1, 1, -1 + rho_col(k) = min( rho_col(k), rho_col(k+1) ) + enddo + + call regridding_set_ppolys(CS%interp_CS, rho_col, nz, h, ppoly_E, ppoly_S, ppoly_C, & + degree, h_neglect, h_neglect_edge) + + R(1) = rho_col(1) + RiAnom(1) = ppoly_E(1,1) - CS%target_density(1) + do k= 2,nz + R(k) = rho_col(k) + if (ppoly_E(k-1,2) > CS%target_density(k)) then + RiAnom(k) = ppoly_E(k-1,2) - CS%target_density(k) !interface is heavier than target + elseif (ppoly_E(k,1) < CS%target_density(k)) then + RiAnom(k) = ppoly_E(k,1) - CS%target_density(k) !interface is lighter than target + else + RiAnom(k) = 0.0 !interface spans the target + endif + enddo + RiAnom(nz+1) = ppoly_E(nz,2) - CS%target_density(nz+1) + +end subroutine build_hycom1_target_anomaly + end module coord_hycom diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index 3f59fac60f..9b574348af 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -14,7 +14,7 @@ module regrid_edge_values ! The following routines are visible to the outside world ! ----------------------------------------------------------------------------- public bound_edge_values, average_discontinuous_edge_values, check_discontinuous_edge_values -public edge_values_explicit_h2, edge_values_explicit_h4 +public edge_values_explicit_h2, edge_values_explicit_h4, edge_values_explicit_h4cw public edge_values_implicit_h4, edge_values_implicit_h6 public edge_slopes_implicit_h3, edge_slopes_implicit_h5 @@ -357,6 +357,106 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answer_date ) end subroutine edge_values_explicit_h4 +!> Compute h4 edge values (explicit fourth order accurate) +!! in the same units as u. +!! +!! From (Colella & Woodward, JCP, 1984) and based on hybgen_ppm_coefs. +!! +!! Compute edge values based on fourth-order explicit estimates. +!! These estimates are based on a cubic interpolant spanning four cells +!! and evaluated at the location of the middle edge. An interpolant spanning +!! cells i-2, i-1, i and i+1 is evaluated at edge i-1/2. The estimate for +!! each edge is unique. +!! +!! i-2 i-1 i i+1 +!! ..--o------o------o------o------o--.. +!! i-1/2 +!! +!! For this fourth-order scheme, at least four cells must exist. +subroutine edge_values_explicit_h4cw( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(N), intent(in) :: h !< cell widths [H] + real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] + real, dimension(N,2), intent(inout) :: edge_val !< Returned edge values [A]; the second index + !! is for the two edges of each cell. + real, optional, intent(in) :: h_neglect !< A negligibly small width [H] + + ! Local variables + real :: dp(N) ! Input grid layer thicknesses, but with a minimum thickness [H ~> m or kg m-2] + real :: hNeglect ! A negligible thickness in the same units as h + real :: da ! Difference between the unlimited scalar edge value estimates [A] + real :: a6 ! Scalar field differences that are proportional to the curvature [A] + real :: slk, srk ! Differences between adjacent cell averages of scalars [A] + real :: sck ! Scalar differences across a cell. + real :: au(N) ! Scalar field difference across each cell [A] + real :: al(N), ar(N) ! Scalar field at the left and right edges of a cell [A] + real :: h112(N+1), h122(N+1) ! Combinations of thicknesses [H ~> m or kg m-2] + real :: I_h12(N+1) ! Inverses of combinations of thickesses [H-1 ~> m-1 or m2 kg-1] + real :: h2_h123(N) ! A ratio of a layer thickness of the sum of 3 adjacent thicknesses [nondim] + real :: I_h0123(N) ! Inverse of the sum of 4 adjacent thicknesses [H-1 ~> m-1 or m2 kg-1] + real :: h01_h112(N+1) ! A ratio of sums of adjacent thicknesses [nondim], 2/3 in the limit of uniform thicknesses. + real :: h23_h122(N+1) ! A ratio of sums of adjacent thicknesses [nondim], 2/3 in the limit of uniform thicknesses. + integer :: k + + hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect + + ! Set the thicknesses for very thin layers to some minimum value. + do k=1,N ; dp(k) = max(h(k), hNeglect) ; enddo + + !compute grid metrics + do k=2,N + h112(K) = 2.*dp(k-1) + dp(k) + h122(K) = dp(k-1) + 2.*dp(k) + I_h12(K) = 1.0 / (dp(k-1) + dp(k)) + enddo !k + do k=2,N-1 + h2_h123(k) = dp(k) / (dp(k) + (dp(k-1)+dp(k+1))) + enddo + do K=3,N-1 + I_h0123(K) = 1.0 / ((dp(k-2) + dp(k-1)) + (dp(k) + dp(k+1))) + + h01_h112(K) = (dp(k-2) + dp(k-1)) / (2.0*dp(k-1) + dp(k)) + h23_h122(K) = (dp(k) + dp(k+1)) / (dp(k-1) + 2.0*dp(k)) + enddo + + !Compute average slopes: Colella, Eq. (1.8) + au(1) = 0. + do k=2,N-1 + slk = u(k )-u(k-1) + srk = u(k+1)-u(k) + if (slk*srk > 0.) then + sck = h2_h123(k)*( h112(K)*srk*I_h12(K+1) + h122(K+1)*slk*I_h12(K) ) + au(k) = sign(min(abs(2.0*slk), abs(sck), abs(2.0*srk)), sck) + else + au(k) = 0. + endif + enddo !k + au(N) = 0. + + !Compute "first guess" edge values: Colella, Eq. (1.6) + al(1) = u(1) ! 1st layer PCM + ar(1) = u(1) ! 1st layer PCM + al(2) = u(1) ! 1st layer PCM + do K=3,N-1 + ! This is a 4th order explicit edge value estimate. + al(k) = (dp(k)*u(k-1) + dp(k-1)*u(k)) * I_h12(K) & + + I_h0123(K)*( 2.*dp(k)*dp(k-1)*I_h12(K)*(u(k)-u(k-1)) * & + ( h01_h112(K) - h23_h122(K) ) & + + (dp(k)*au(k-1)*h23_h122(K) - dp(k-1)*au(k)*h01_h112(K)) ) + ar(k-1) = al(k) + enddo !k + ar(N-1) = u(N) ! last layer PCM + al(N) = u(N) ! last layer PCM + ar(N) = u(N) ! last layer PCM + + !Set coefficients + do k=1,N + edge_val(k,1) = al(k) + edge_val(k,2) = ar(k) + enddo !k + +end subroutine edge_values_explicit_h4cw + !> Compute ih4 edge values (implicit fourth order accurate) !! in the same units as u. !! diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 4d09daf6f3..e119ce9d53 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -7,11 +7,13 @@ module regrid_interp use MOM_string_functions, only : uppercase use regrid_edge_values, only : edge_values_explicit_h2, edge_values_explicit_h4 +use regrid_edge_values, only : edge_values_explicit_h4cw use regrid_edge_values, only : edge_values_implicit_h4, edge_values_implicit_h6 use regrid_edge_values, only : edge_slopes_implicit_h3, edge_slopes_implicit_h5 use PLM_functions, only : PLM_reconstruction, PLM_boundary_extrapolation use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use PPM_functions, only : PPM_monotonicity use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 use P1M_functions, only : P1M_interpolation, P1M_boundary_extrapolation @@ -45,6 +47,7 @@ module regrid_interp integer, parameter :: INTERPOLATION_P1M_H4 = 1 !< O(h^2) integer, parameter :: INTERPOLATION_P1M_IH4 = 2 !< O(h^2) integer, parameter :: INTERPOLATION_PLM = 3 !< O(h^2) +integer, parameter :: INTERPOLATION_PPM_CW =10 !< O(h^3) integer, parameter :: INTERPOLATION_PPM_H4 = 4 !< O(h^3) integer, parameter :: INTERPOLATION_PPM_IH4 = 5 !< O(h^3) integer, parameter :: INTERPOLATION_P3M_IH4IH3 = 6 !< O(h^4) @@ -144,6 +147,25 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & call PLM_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) endif + case ( INTERPOLATION_PPM_CW ) + if ( n0 >= 4 ) then + degree = DEGREE_2 + call edge_values_explicit_h4cw( n0, h0, densities, ppoly0_E, h_neglect_edge ) + call PPM_monotonicity( n0, densities, ppoly0_E ) + call PPM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) + if (extrapolate) then + call PPM_boundary_extrapolation( n0, h0, densities, ppoly0_E, & + ppoly0_coefs, h_neglect ) + endif + else + degree = DEGREE_1 + call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) + if (extrapolate) then + call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) + endif + endif + case ( INTERPOLATION_PPM_H4 ) if ( n0 >= 4 ) then degree = DEGREE_2 @@ -486,7 +508,7 @@ end function get_polynomial_coordinate !> Numeric value of interpolation_scheme corresponding to scheme name integer function interpolation_scheme(interp_scheme) character(len=*), intent(in) :: interp_scheme !< Name of the interpolation scheme - !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_H4", + !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_CW", "PPM_H4", !! "PPM_IH4", "P3M_IH4IH3", "P3M_IH6IH5", "PQM_IH4IH3", and "PQM_IH6IH5" select case ( uppercase(trim(interp_scheme)) ) @@ -494,6 +516,7 @@ integer function interpolation_scheme(interp_scheme) case ("P1M_H4"); interpolation_scheme = INTERPOLATION_P1M_H4 case ("P1M_IH2"); interpolation_scheme = INTERPOLATION_P1M_IH4 case ("PLM"); interpolation_scheme = INTERPOLATION_PLM + case ("PPM_CW"); interpolation_scheme = INTERPOLATION_PPM_CW case ("PPM_H4"); interpolation_scheme = INTERPOLATION_PPM_H4 case ("PPM_IH4"); interpolation_scheme = INTERPOLATION_PPM_IH4 case ("P3M_IH4IH3"); interpolation_scheme = INTERPOLATION_P3M_IH4IH3 @@ -509,7 +532,7 @@ end function interpolation_scheme subroutine set_interp_scheme(CS, interp_scheme) type(interp_CS_type), intent(inout) :: CS !< A control structure for regrid_interp character(len=*), intent(in) :: interp_scheme !< Name of the interpolation scheme - !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_H4", + !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_CW", "PPM_H4", !! "PPM_IH4", "P3M_IH4IH3", "P3M_IH6IH5", "PQM_IH4IH3", and "PQM_IH6IH5" CS%interpolation_scheme = interpolation_scheme(interp_scheme) From 1bb66a44c27242f3390906267e545d9f4f7e32f8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 20 Feb 2023 09:39:25 -0500 Subject: [PATCH 193/213] +Update check_MOM6_scaling_factors with C and S Updated check_MOM6_scaling_factors and compose_dimension_list to reflect that fact that MOM6 is now doing dimensional consistency testing for temperature (via [C ~> degC]) and salinity (via [S ~> ppt]), with an expanded dimension of the scaling key from 6 to 8 and additional calls to add_scaling. Also updated the weights on the add_scaling calls, which are essentially counts of the frequency of the various unit descriptors in the MOM6 code, to reflect only the counts of variables with doxygen comments (i.e., arguments, function return values and elements of types) but excluding the user, framework and diagnostics directories and the passive tracer packages. All model solutions are bitwise identical, but there will be updated suggestions for combinations of scaling factors that minimize the aliasing of the units that are used. --- src/core/MOM_check_scaling.F90 | 248 +++++++++++++++++---------------- 1 file changed, 131 insertions(+), 117 deletions(-) diff --git a/src/core/MOM_check_scaling.F90 b/src/core/MOM_check_scaling.F90 index 55bd471fee..1d7c27b6fd 100644 --- a/src/core/MOM_check_scaling.F90 +++ b/src/core/MOM_check_scaling.F90 @@ -28,19 +28,23 @@ subroutine check_MOM6_scaling_factors(GV, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - integer, parameter :: ndims = 6 ! The number of rescalable dimensional factors. + integer, parameter :: ndims = 8 ! The number of rescalable dimensional factors. real, dimension(ndims) :: scales ! An array of scaling factors for each of the basic units. integer, dimension(ndims) :: scale_pow2 ! The powers of 2 that give each element of scales. character(len=2), dimension(ndims) :: key - ! character(len=128) :: mesg, msg_frag integer, allocatable :: weights(:) character(len=80), allocatable :: descriptions(:) - ! logical :: verbose, very_verbose integer :: n, ns, max_pow + ! If no scaling is being done, simply return. + if ((US%Z_to_m == 1.) .and. (GV%H_to_MKS == 1.) .and. (US%L_to_m == 1.) .and. & + (US%T_to_s == 1.) .and. (US%R_to_kg_m3 == 1.) .and. (US%Q_to_J_kg == 1.) .and. & + (US%C_to_degC == 1.) .and. (US%S_to_ppt == 1.)) return + ! Set the names and scaling factors of the dimensions being rescaled. - key(:) = ["Z", "H", "L", "T", "R", "Q"] - scales(:) = (/ US%Z_to_m, GV%H_to_MKS, US%L_to_m, US%T_to_s, US%R_to_kg_m3, US%Q_to_J_kg /) + key(:) = ["Z", "H", "L", "T", "R", "Q", "C", "S"] + scales(:) = (/ US%Z_to_m, GV%H_to_MKS, US%L_to_m, US%T_to_s, US%R_to_kg_m3, US%Q_to_J_kg, & + US%C_to_degC, US%S_to_ppt/) call scales_to_powers(scales, scale_pow2) max_pow = 40 ! 60 @@ -71,124 +75,134 @@ subroutine compose_dimension_list(ns, des, wts) !! perhaps the number of times it occurs in the MOM6 code. ns = 0 - ! Accumulate a list of units used in MOM6, in approximate descending order of frequency of occurrence. - call add_scaling(ns, des, wts, "[H ~> m or kg m-2]", 1239) ! Layer thicknesses - call add_scaling(ns, des, wts, "[Z ~> m]", 660) ! Depths and vertical distance - call add_scaling(ns, des, wts, "[L T-1 ~> m s-1]", 506) ! Horizontal velocities - call add_scaling(ns, des, wts, "[R ~> kg m-3]", 356) ! Densities - call add_scaling(ns, des, wts, "[T-1 ~> s-1]", 247) ! Rates - call add_scaling(ns, des, wts, "[T ~> s]", 237) ! Time intervals - call add_scaling(ns, des, wts, "[R L2 T-2 ~> Pa]", 231) ! Dynamic pressure + ! Accumulate a list of units used in MOM6, in approximate descending order of frequency of occurrence in + ! doxygen comments (i.e., arguments and elements in types), excluding the code in the user, ice_shelf and + ! framework directories and the passive tracer packages. + call add_scaling(ns, des, wts, "[H ~> m or kg m-2]", 716) ! Layer thicknesses + call add_scaling(ns, des, wts, "[L T-1 ~> m s-1]", 264) ! Horizontal velocities + call add_scaling(ns, des, wts, "[Z ~> m]", 244) ! Depths and vertical distance + call add_scaling(ns, des, wts, "[T ~> s]", 154) ! Time intervals + call add_scaling(ns, des, wts, "[S ~> ppt]", 135) ! Salinities + call add_scaling(ns, des, wts, "[C ~> degC]", 135) ! Temperatures + call add_scaling(ns, des, wts, "[R L2 T-2 ~> Pa]", 133) ! Dynamic pressure ! call add_scaling(ns, des, wts, "[R L2 T-2 ~> J m-3]") ! Energy density - call add_scaling(ns, des, wts, "[Z2 T-1 ~> m2 s-1]", 181) ! Vertical viscosities and diffusivities - call add_scaling(ns, des, wts, "[H L2 ~> m3 or kg]", 174) ! Cell volumes or masses - call add_scaling(ns, des, wts, "[H L2 T-1 ~> m3 s-1 or kg s-1]", 163) ! Volume or mass transports - call add_scaling(ns, des, wts, "[L T-2 ~> m s-2]", 136) ! Horizontal accelerations - call add_scaling(ns, des, wts, "[L ~> m]", 107) ! Horizontal distances - call add_scaling(ns, des, wts, "[Z T-1 ~> m s-1]", 104) ! Friction velocities and viscous coupling - call add_scaling(ns, des, wts, "[H-1 ~> m-1 or m2 kg-1]", 89) ! Inverse cell thicknesses - call add_scaling(ns, des, wts, "[L2 T-2 ~> m2 s-2]", 88) ! Resolved kinetic energy per unit mass - call add_scaling(ns, des, wts, "[R Z3 T-2 ~> J m-2]", 85) ! Integrated turbulent kinetic energy density - call add_scaling(ns, des, wts, "[L2 T-1 ~> m2 s-1]", 78) ! Horizontal viscosity or diffusivity - call add_scaling(ns, des, wts, "[T-2 ~> s-2]", 69) ! Squared shears and buoyancy frequency - call add_scaling(ns, des, wts, "[H L ~> m2 or kg m-1]", 68) ! Lateral cell face areas - call add_scaling(ns, des, wts, "[L2 ~> m2]", 67) ! Horizontal areas - - call add_scaling(ns, des, wts, "[R-1 ~> m3 kg-1]", 61) ! Specific volumes - call add_scaling(ns, des, wts, "[Q R Z T-1 ~> W m-2]", 62) ! Vertical heat fluxes - call add_scaling(ns, des, wts, "[Z-1 ~> m-1]", 60) ! Inverse vertical distances - call add_scaling(ns, des, wts, "[L2 Z-1 T-2 ~> m s-2]", 57) ! Gravitational acceleration - call add_scaling(ns, des, wts, "[R Z T-1 ~> kg m-2 s-1]", 52) ! Vertical mass fluxes - call add_scaling(ns, des, wts, "[H T-1 ~> m s-1 or kg m-2 s-1]", 51) ! Vertical thickness fluxes - call add_scaling(ns, des, wts, "[R Z3 T-3 ~> W m-2]", 45) ! Integrated turbulent kinetic energy sources - call add_scaling(ns, des, wts, "[R Z ~> kg m-2]", 42) ! Layer or column mass loads - call add_scaling(ns, des, wts, "[Z3 T-3 ~> m3 s-3]", 33) ! Integrated turbulent kinetic energy sources - call add_scaling(ns, des, wts, "[H2 ~> m2 or kg2 m-4]", 35) ! Squared layer thicknesses - call add_scaling(ns, des, wts, "[Z2 T-2 ~> m2 s-2]", 33) ! Turbulent kinetic energy - call add_scaling(ns, des, wts, "[L-1 ~> m-1]", 32) ! Inverse horizontal distances - call add_scaling(ns, des, wts, "[R L Z T-2 ~> Pa]", 27) ! Wind stresses - call add_scaling(ns, des, wts, "[T2 L-2 ~> s2 m-2]", 33) ! Inverse velocities squared - call add_scaling(ns, des, wts, "[R Z L2 T-2 ~> J m-2]", 25) ! Integrated energy - ! call add_scaling(ns, des, wts, "[R L2 Z T-2 ~> Pa m]") ! Depth integral of pressures (25) - call add_scaling(ns, des, wts, "[Z L2 T-2 ~> m3 s-2]", 25) ! Integrated energy - call add_scaling(ns, des, wts, "[H R ~> kg m-2 or kg2 m-5]", 24) ! Layer-integrated density - call add_scaling(ns, des, wts, "[L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]", 20) ! pbce or gtot - call add_scaling(ns, des, wts, "[L-1 T-1 ~> m-1 s-1]", 19) ! Laplacian of velocity - - call add_scaling(ns, des, wts, "[L4 T-1 ~> m4 s-1]", 18) ! Biharmonic viscosity - call add_scaling(ns, des, wts, "[Z L T-1 ~> m2 s-1]", 17) ! Layer integrated velocities - call add_scaling(ns, des, wts, "[Z L-1 ~> nondim]", 15) ! Slopes - call add_scaling(ns, des, wts, "[Z L2 ~> m3]", 14) ! Diagnostic volumes - call add_scaling(ns, des, wts, "[H L T-1 ~> m2 s-1 or kg m-1 s-1]", 12) ! Layer integrated velocities - call add_scaling(ns, des, wts, "[L2 T-3 ~> m2 s-3]", 14) ! Buoyancy flux or MEKE sources [L2 T-3 ~> W kg-1] - call add_scaling(ns, des, wts, "[Z2 ~> m2]", 12) ! Squared vertical distances - call add_scaling(ns, des, wts, "[R Z L2 T-1 ~> kg s-1]", 12) ! Mass fluxes - call add_scaling(ns, des, wts, "[L-2 ~> m-2]", 12) ! Inverse areas - call add_scaling(ns, des, wts, "[L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]", 11) ! Gravitational acceleration over density - call add_scaling(ns, des, wts, "[Z T-2 ~> m s-2]", 10) ! Buoyancy differences or their derivatives - ! Could also add [Z T-2 degC-1 ~> m s-2 degC-1] or [Z T-2 ppt-1 ~> m s-2 ppt-1] - call add_scaling(ns, des, wts, "[R Z L2 T-3 ~> W m-2]", 10) ! Energy sources, including for MEKE - call add_scaling(ns, des, wts, "[L3 ~> m3]", 10) ! Metric dependent constants for viscosity - call add_scaling(ns, des, wts, "[Z-2 ~> m-2]", 9) ! Inverse of denominator in some weighted averages - call add_scaling(ns, des, wts, "[H-2 ~> m-2 or m4 kg-2]", 9) ! Mixed layer local work variables - call add_scaling(ns, des, wts, "[Z L2 T-1 ~> m3 s-1]", 9) ! Overturning (GM) streamfunction - call add_scaling(ns, des, wts, "[L2 Z-2 T-2 ~> s-2]", 9) ! Buoyancy frequency in some params. - call add_scaling(ns, des, wts, "[Q R Z ~> J m-2]", 8) ! time-integrated frazil heat flux + call add_scaling(ns, des, wts, "[Z2 T-1 ~> m2 s-1]", 132) ! Vertical viscosities and diffusivities + call add_scaling(ns, des, wts, "[R ~> kg m-3]", 122) ! Densities + + call add_scaling(ns, des, wts, "[H L2 T-1 ~> m3 s-1 or kg s-1]", 97) ! Volume or mass transports + call add_scaling(ns, des, wts, "[H L2 ~> m3 or kg]", 91) ! Cell volumes or masses + call add_scaling(ns, des, wts, "[L T-2 ~> m s-2]", 82) ! Horizontal accelerations + call add_scaling(ns, des, wts, "[T-1 ~> s-1]", 67) ! Rates + call add_scaling(ns, des, wts, "[Z T-1 ~> m s-1]", 56) ! Friction velocities and viscous coupling + call add_scaling(ns, des, wts, "[Q R Z T-1 ~> W m-2]", 42) ! Vertical heat fluxes + call add_scaling(ns, des, wts, "[L2 T-1 ~> m2 s-1]", 45) ! Horizontal viscosity or diffusivity + call add_scaling(ns, des, wts, "[L2 T-2 ~> m2 s-2]", 37) ! Resolved kinetic energy per unit mass + call add_scaling(ns, des, wts, "[L ~> m]", 35) ! Horizontal distances + call add_scaling(ns, des, wts, "[T-2 ~> s-2]", 33) ! Squared shears and buoyancy frequency + + call add_scaling(ns, des, wts, "[R Z L T-2 ~> Pa]", 33) ! Wind stresses + call add_scaling(ns, des, wts, "[H L ~> m2 or kg m-1]", 32) ! Lateral cell face areas + call add_scaling(ns, des, wts, "[L2 ~> m2]", 31) ! Horizontal areas + call add_scaling(ns, des, wts, "[R C-1 ~> kg m-3 degC-1]", 26) ! Thermal expansion coefficients + call add_scaling(ns, des, wts, "[L2 Z-1 T-2 ~> m s-2]", 26) ! Gravitational acceleration + call add_scaling(ns, des, wts, "[R S-1 ~> kg m-3 ppt-1]", 23) ! Haline contraction coefficients + call add_scaling(ns, des, wts, "[R Z3 T-3 ~> W m-2]", 23) ! Integrated turbulent kinetic energy sources + call add_scaling(ns, des, wts, "[R Z T-1 ~> kg m-2 s-1]", 19) ! Vertical mass fluxes + call add_scaling(ns, des, wts, "[C H ~> degC m or degC kg m-2]", 17) ! Heat content + call add_scaling(ns, des, wts, "[H-1 ~> m-1 or m2 kg-1]", 17) ! Inverse cell thicknesses + + call add_scaling(ns, des, wts, "[Z-1 ~> m-1]", 14) ! Inverse vertical distances + call add_scaling(ns, des, wts, "[R-1 ~> m3 kg-1]", 14) ! Specific volumes + call add_scaling(ns, des, wts, "[Z L-1 ~> nondim]", 12) ! Slopes + call add_scaling(ns, des, wts, "[L-1 ~> m-1]", 12) ! Inverse horizontal distances + call add_scaling(ns, des, wts, "[L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]", 12) ! pbce or gtot + call add_scaling(ns, des, wts, "[R Z ~> kg m-2]", 11) ! Layer or column mass loads + call add_scaling(ns, des, wts, "[Z L2 T-2 ~> m3 s-2]", 11) ! Integrated energy per unit mass + call add_scaling(ns, des, wts, "[R Z3 T-2 ~> J m-2]", 11) ! Integrated turbulent kinetic energy density + call add_scaling(ns, des, wts, "[H T-1 ~> m s-1 or kg m-2 s-1]", 9) ! Vertical thickness fluxes + call add_scaling(ns, des, wts, "[L-1 T-1 ~> m-1 s-1]", 9) ! Laplacian of velocity + + call add_scaling(ns, des, wts, "[Z3 T-3 ~> m3 s-3]", 9) ! Integrated turbulent kinetic energy sources + call add_scaling(ns, des, wts, "[S H ~> ppt m or ppt kg m-2]", 8) ! Depth integrated salinity + call add_scaling(ns, des, wts, "[Z2 T-2 ~> m2 s-2]", 8) ! Turbulent kinetic energy + call add_scaling(ns, des, wts, "[R L2 Z T-2 ~> Pa m]", 7) ! Vertically integrated pressure anomalies call add_scaling(ns, des, wts, "[Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]", 7) ! (TKE_to_Kd) - call add_scaling(ns, des, wts, "[Q degC-1 ~> J kg-1 degC-1]", 7) ! Heat capacity - - call add_scaling(ns, des, wts, "[R Z2 T-2 ~> J m-3]", 6) ! Potential energy height derivatives - call add_scaling(ns, des, wts, "[R Z3 T-2 H-1 ~> J m-3 or J kg-1]", 7) ! Partial derivatives of energy - call add_scaling(ns, des, wts, "[R L2 T-2 Z-1 ~> Pa m-1]", 7) ! Converts depth to pressure - call add_scaling(ns, des, wts, "[L4 Z-1 T-1 ~> m3 s-1]", 7) ! Rigidity of ice - call add_scaling(ns, des, wts, "[H L2 T-3 ~> m3 s-3]", 9) ! Kinetic energy diagnostics - call add_scaling(ns, des, wts, "[H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]", 6) ! Layer potential vorticity - call add_scaling(ns, des, wts, "[R Z2 T-3 ~> W m-3]", 3) ! Kinetic energy dissipation rates - call add_scaling(ns, des, wts, "[Z2 L-2 ~> 1]", 1) ! Slopes squared - call add_scaling(ns, des, wts, "[Z H-1 ~> nondim or m3 kg-1]", 6) ! Thickness to height conversion - call add_scaling(ns, des, wts, "[Pa T2 R-1 L-2 ~> 1]", 6) ! Pressure conversion factor - ! Could also add [m T2 R-1 L-2 ~> m Pa-1] - ! Could also add [degC T2 R-1 L-2 ~> degC Pa-1] - call add_scaling(ns, des, wts, "[R H-1 ~> kg m-4 or m-1]", 5) ! Vertical density gradients + call add_scaling(ns, des, wts, "[L4 T-1 ~> m4 s-1]", 7) ! Biharmonic viscosity + call add_scaling(ns, des, wts, "[L3 ~> m3]", 7) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[L2 T-3 ~> m2 s-3]", 7) ! Buoyancy flux or MEKE sources [L2 T-3 ~> W kg-1] + call add_scaling(ns, des, wts, "[H2 ~> m2 or kg2 m-4]", 7) ! Squared layer thicknesses + call add_scaling(ns, des, wts, "[C H T-1 ~> degC m s-1 or degC kg m-2 s-1]", 7) ! vertical heat fluxes + + call add_scaling(ns, des, wts, "[L-2 ~> m-2]", 6) ! Inverse areas + call add_scaling(ns, des, wts, "[R Z L2 T-3 ~> W m-2]", 6) ! Energy sources, including for MEKE + call add_scaling(ns, des, wts, "[Z2 T-3 ~> m2 s-3]", 5) ! Certain buoyancy fluxes + call add_scaling(ns, des, wts, "[Z2 ~> m2]", 5) ! Squared vertical distances + call add_scaling(ns, des, wts, "[S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]", 5) ! vertical salinity fluxes + call add_scaling(ns, des, wts, "[R-1 C-1 ~> m3 kg-1 degC-1]", 5) ! Specific volume temperature gradient + call add_scaling(ns, des, wts, "[R-1 S-1 ~> m3 kg-1 ppt-1]", 4) ! Specific volume salnity gradient + call add_scaling(ns, des, wts, "[Q R Z ~> J m-2]", 4) ! time-integrated frazil heat flux + call add_scaling(ns, des, wts, "[Z C-1 ~> m degC-1]", 4) ! Inverse temperature gradients + call add_scaling(ns, des, wts, "[Z S-1 ~> m ppt-1]", 4) ! Inverse salinity gradients + + call add_scaling(ns, des, wts, "[R Z3 T-2 H-1 ~> J m-3 or J kg-1]", 4) ! Partial derivatives of energy + call add_scaling(ns, des, wts, "[R Z3 T-2 S-1 ~> J m-2 ppt-1]", 4) ! Sensitity of energy change to salinity + call add_scaling(ns, des, wts, "[R Z3 T-2 C-1 ~> J m-2 degC-1]", 4) ! Sensitity of energy change to temperature call add_scaling(ns, des, wts, "[R L4 T-4 ~> Pa m2 s-2]", 4) ! Integral in geopotential of pressure - call add_scaling(ns, des, wts, "[L Z-1 ~> nondim]", 4) ! Inverse slopes + call add_scaling(ns, des, wts, "[Q ~> J kg-1]", 4) ! Latent heats + call add_scaling(ns, des, wts, "[Q C-1 ~> J kg-1 degC-1]", 4) ! Heat capacity call add_scaling(ns, des, wts, "[L-3 ~> m-3]", 4) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[L2 Z-2 T-2 ~> s-2]", 4) ! Buoyancy frequency in some params. + call add_scaling(ns, des, wts, "[H R ~> kg m-2 or kg2 m-5]", 4) ! Layer-integrated density + call add_scaling(ns, des, wts, "[H L T-1 ~> m2 s-1 or kg m-1 s-1]", 4) ! Layer integrated velocities + call add_scaling(ns, des, wts, "[H T2 L-1 ~> s2 or kg s2 m-3]", 4) ! BT_cont_type face curvature fit call add_scaling(ns, des, wts, "[H L-1 ~> nondim or kg m-3]", 4) ! BT_cont_type face curvature fit - call add_scaling(ns, des, wts, "[kg H-1 L-2 ~> kg m-3 or 1]", 20) ! Diagnostic conversions to mass - ! Could also add [m3 H-1 L-2 ~> 1 or m3 kg-1] - call add_scaling(ns, des, wts, "[Z T-2 R-1 ~> m4 s-2 kg-1]", 9) ! Gravitational acceleration over density - call add_scaling(ns, des, wts, "[R Z L4 T-3 ~> kg m2 s-3]", 9) ! MEKE fluxes - call add_scaling(ns, des, wts, "[R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]", 3) ! Thickness to pressure conversion - - call add_scaling(ns, des, wts, "[R-1 Z-1 ~> m2 kg-1]", 3) ! Inverse of column mass - call add_scaling(ns, des, wts, "[L4 ~> m4]", 3) ! Metric dependent constants for viscosity - call add_scaling(ns, des, wts, "[T-1 Z-1 ~> s-1 m-1]", 2) ! Barotropic PV, for some options - call add_scaling(ns, des, wts, "[R Z2 T-1 ~> J s m-3]", 2) ! River mixing term [R Z2 T-1 ~> Pa s] - call add_scaling(ns, des, wts, "[degC Q-1 ~> kg degC J-1]", 2) ! Inverse heat capacity - ! Could add call add_scaling(ns, des, wts, "[Q-1 ~> kg J-1]", 1) ! Inverse heat content - call add_scaling(ns, des, wts, "[L4 Z-2 T-1 ~> m2 s-1]", 2) ! Ice rigidity term - call add_scaling(ns, des, wts, "[R Z-1 ~> kg m-4]", 3) ! Vertical density gradient - call add_scaling(ns, des, wts, "[R Z L2 ~> kg]", 3) ! Depth and time integrated mass fluxes - call add_scaling(ns, des, wts, "[R L2 T-3 ~> W m-2]", 3) ! Depth integrated friction work - call add_scaling(ns, des, wts, "[ppt2 R-2 ~> ppt2 m6 kg-2]", 3) ! T / S gauge transformation - call add_scaling(ns, des, wts, "[R L-1 ~> kg m-4]", 2) ! Horizontal density gradient - ! Could add call add_scaling(ns, des, wts, "[H Z ~> m2 or kg m-1]", 2) ! Temporary variables - call add_scaling(ns, des, wts, "[Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]", 2) ! Heating to PE change - call add_scaling(ns, des, wts, "[R2 L2 Z2 T-4 ~> Pa2]", 2) ! Squared wind stresses - call add_scaling(ns, des, wts, "[L-2 T-2 ~> m-2 s-2]", 2) ! Squared Laplacian of velocity - call add_scaling(ns, des, wts, "[T H Z-1 ~> s or s kg m-3]", 2) ! Time step times thickness conversion - call add_scaling(ns, des, wts, "[T H Z-1 R-1 ~> s m3 kg-1 or s]", 2) ! Time step over density with conversion - call add_scaling(ns, des, wts, "[H-3 ~> m-3 or m6 kg-3]", 1) ! A local term in ePBL - call add_scaling(ns, des, wts, "[H-4 ~> m-4 or m8 kg-4]", 1) ! A local term in ePBL - call add_scaling(ns, des, wts, "[H T Z-2 ~> s m-1 or kg s m-4]", 1) ! A local term in ePBL - - call add_scaling(ns, des, wts, "[H3 ~> m3 or kg3 m-6]", 1) ! Thickness cubed in a denominator - call add_scaling(ns, des, wts, "[H2 T-2 ~> m2 s-2 or kg2 m-4 s-2]", 1) ! Thickness times f squared - call add_scaling(ns, des, wts, "[H T2 R-1 Z-2 ~> m Pa-1 or s2 m-1]", 1) ! Pressure to thickness conversion - call add_scaling(ns, des, wts, "[L2 Z-2 ~> nondim]", 1) ! Inverse slope squared - call add_scaling(ns, des, wts, "[H R L2 T-2 ~> m Pa]", 1) ! Integral in thickness of pressure - call add_scaling(ns, des, wts, "[R T2 Z-1 ~> kg s2 m-4]", 1) ! Density divided by gravitational acceleration + call add_scaling(ns, des, wts, "[C2 ~> degC2]", 4) ! Squared temperature anomalies + call add_scaling(ns, des, wts, "[S2 ~> ppt2]", 3) ! Squared salinity anomalies + call add_scaling(ns, des, wts, "[C S ~> degC ppt]", 3) ! Covariance of temperature and salinity anomalies + call add_scaling(ns, des, wts, "[S R Z ~> gSalt m-2]", 3) ! Total ocean column salt + call add_scaling(ns, des, wts, "[C R Z ~> degC kg m-2]", 3) ! Total ocean column temperature + call add_scaling(ns, des, wts, "[Pa T2 R-1 L-2 ~> 1]", 3) ! Pressure conversions + call add_scaling(ns, des, wts, "[Z H-1 ~> nondim or m3 kg-1]", 3) ! Thickness to height conversion + call add_scaling(ns, des, wts, "[R Z2 T-2 ~> J m-3]", 3) ! Potential energy height derivatives + + call add_scaling(ns, des, wts, "[H-2 ~> m-2 or m4 kg-2]", 3) ! Mixed layer local work variables + call add_scaling(ns, des, wts, "[C S-1 ~> degC ppt-1]", 2) ! T / S gauge transformation + call add_scaling(ns, des, wts, "[R S-2 ~> kg m-3 ppt-2]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[R C-2 ~> kg m-3 degC-2]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[R S-1 C-1 ~> kg m-3 ppt-1 degC-1]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[T2 L-2 ~> s2 m-2]", 2) ! Inverse velocities squared + call add_scaling(ns, des, wts, "[R Z2 T-3 ~> W m-3]", 2) ! Kinetic energy dissipation rates + call add_scaling(ns, des, wts, "[R H-1 ~> kg m-4 or m-1]", 2) ! Vertical density gradients + + call add_scaling(ns, des, wts, "[L4 ~> m4]", 2) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[Z L T-1 ~> m2 s-1]", 2) ! Layer integrated velocities + call add_scaling(ns, des, wts, "[C Z ~> degC m]", 2) ! Depth integrated temperature + call add_scaling(ns, des, wts, "[S Z ~> ppt m]", 1) ! Layer integrated salinity + call add_scaling(ns, des, wts, "[T L4 ~> s m4]", 2) ! Biharmonic metric dependent constant + call add_scaling(ns, des, wts, "[L6 ~> m6]", 2) ! Biharmonic Leith metric dependent constant + call add_scaling(ns, des, wts, "[L4 Z-1 T-1 ~> m3 s-1]", 2) ! Rigidity of ice + call add_scaling(ns, des, wts, "[L4 Z-2 T-1 ~> m2 s-1]", 1) ! Ice rigidity term + call add_scaling(ns, des, wts, "[R-1 Z-1 ~> m2 kg-1]", 1) ! Inverse of column mass + call add_scaling(ns, des, wts, "[Z-2 ~> m-2]", 1) ! Inverse of denominator in some weighted averages + + call add_scaling(ns, des, wts, "[R Z2 T-1 ~> J s m-3]", 1) ! River mixing term + call add_scaling(ns, des, wts, "[R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]", 1) ! Thickness to pressure conversion + call add_scaling(ns, des, wts, "[Z T2 R-1 L-2 ~> m Pa-1]", 1) ! Atmospheric pressure SSH correction + call add_scaling(ns, des, wts, "[T Z ~> s m] ", 1) ! Time integrated SSH + call add_scaling(ns, des, wts, "[Z-1 T-1 ~> m-1 s-1]", 1) ! barotropic PV + call add_scaling(ns, des, wts, "[L2 T ~> m2 s]", 1) ! Greatbatch & Lamb 90 coefficient + call add_scaling(ns, des, wts, "[Z L2 T-1 ~> m3 s-1]", 1) ! Overturning (GM) streamfunction + call add_scaling(ns, des, wts, "[kg H-1 L-2 ~> kg m-3 or 1]", 1) ! Diagnostic conversions to mass + call add_scaling(ns, des, wts, "[S-1 ~> ppt-1]", 1) ! Unscaling salinity + call add_scaling(ns, des, wts, "[C-1 ~> degC-1]", 1) ! Unscaling temperature + + call add_scaling(ns, des, wts, "[R Z H-1 ~> kg m-3 or 1] ", 1) ! A unit conversion factor + call add_scaling(ns, des, wts, "[H R-1 Z-1 ~> m3 kg-2 or 1]", 1) ! A unit conversion factor + call add_scaling(ns, des, wts, "[H Z-1 ~> 1 or kg m-3]", 1) ! A unit conversion factor + call add_scaling(ns, des, wts, "[m T s-1 L-1 ~> 1]", 1) ! A unit conversion factor end subroutine compose_dimension_list From 19f861314c21f3b24fa2c7bb951e6fc73761a854 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Mar 2023 09:31:41 -0400 Subject: [PATCH 194/213] +(*)Remove coord_SLight Removed the coord_slight module and all calls to it, and obsoleted all run-time parameters that are exclusively related to it. This code was an attempt from 2015 to define an appropriate hybrid vertical coordinate for global climate modeling, but it never worked very well (usually falling apart in the second year), and it has not been used in any publication or active model for many years. The test case that exercised this coordinate in the MOM6-examples test suite is also being removed via MOM6-examples PR #388. The coord_SLight code is being eliminated altogether now to simplify the MOM6 code base and reduce the volume of untested and unused code. All answers in all known MOM6 configurations in active use are bitwise identical, although there is a remote chance that someone somewhere might be using the SLIGHT coordinate. --- src/ALE/MOM_regridding.F90 | 188 +----- src/ALE/coord_slight.F90 | 733 ------------------------ src/ALE/regrid_consts.F90 | 6 - src/diagnostics/MOM_obsolete_params.F90 | 8 + src/framework/MOM_diag_remap.F90 | 4 - 5 files changed, 18 insertions(+), 921 deletions(-) delete mode 100644 src/ALE/coord_slight.F90 diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 5e46b8d1f6..b9d74c01a2 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -22,7 +22,7 @@ module MOM_regridding use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA use regrid_consts, only : REGRIDDING_ARBITRARY, REGRIDDING_SIGMA_SHELF_ZSTAR -use regrid_consts, only : REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_SLIGHT, REGRIDDING_ADAPTIVE +use regrid_consts, only : REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_ADAPTIVE use regrid_interp, only : interp_CS_type, set_interp_scheme, set_interp_extrap use coord_zlike, only : init_coord_zlike, zlike_CS, set_zlike_params, build_zstar_column, end_coord_zlike @@ -30,7 +30,6 @@ module MOM_regridding use coord_rho, only : init_coord_rho, rho_CS, set_rho_params, build_rho_column, end_coord_rho use coord_rho, only : old_inflate_layers_1d use coord_hycom, only : init_coord_hycom, hycom_CS, set_hycom_params, build_hycom1_column, end_coord_hycom -use coord_slight, only : init_coord_slight, slight_CS, set_slight_params, build_slight_column, end_coord_slight use coord_adapt, only : init_coord_adapt, adapt_CS, set_adapt_params, build_adapt_column, end_coord_adapt use MOM_hybgen_regrid, only : hybgen_regrid, hybgen_regrid_CS, init_hybgen_regrid, end_hybgen_regrid use MOM_hybgen_regrid, only : write_Hybgen_coord_file @@ -61,7 +60,7 @@ module MOM_regridding !! This array is the nominal coordinate of interfaces and is the !! running sum of coordinateResolution, in [R ~> kg m-3]. i.e. !! target_density(k+1) = coordinateResolution(k) + coordinateResolution(k) - !! It is only used in "rho", "SLight" or "Hycom" mode. + !! It is only used in "rho" or "Hycom" mode. real, dimension(:), allocatable :: target_density !> A flag to indicate that the target_density arrays has been filled with data. @@ -129,7 +128,6 @@ module MOM_regridding type(sigma_CS), pointer :: sigma_CS => null() !< Control structure for sigma coordinate generator type(rho_CS), pointer :: rho_CS => null() !< Control structure for rho coordinate generator type(hycom_CS), pointer :: hycom_CS => null() !< Control structure for hybrid coordinate generator - type(slight_CS), pointer :: slight_CS => null() !< Control structure for Slight-coordinate generator type(adapt_CS), pointer :: adapt_CS => null() !< Control structure for adaptive coordinate generator type(hybgen_regrid_CS), pointer :: hybgen_CS => NULL() !< Control structure for hybgen regridding @@ -157,7 +155,6 @@ module MOM_regridding " RHO - continuous isopycnal\n"//& " HYCOM1 - HyCOM-like hybrid coordinate\n"//& " HYBGEN - Hybrid coordinate from the Hycom hybgen code\n"//& - " SLIGHT - stretched coordinates above continuous isopycnal\n"//& " ADAPTIVE - optimize for smooth neutral density surfaces" !> Documentation for regridding interpolation schemes @@ -209,18 +206,17 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m character(len=200) :: inputdir, fileName character(len=320) :: message ! Temporary strings character(len=12) :: expected_units, alt_units ! Temporary strings - logical :: tmpLogical, fix_haloclines, do_sum, main_parameters + logical :: tmpLogical, do_sum, main_parameters logical :: coord_is_state_dependent, ierr integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: remap_answers_2018 integer :: remap_answer_date ! The vintage of the remapping expressions to use. - real :: filt_len, strat_tol, tmpReal, P_Ref + real :: tmpReal, P_Ref real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). - real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha real :: adaptDrho0 ! Reference density difference for stratification-dependent diffusion. [R ~> kg m-3] - integer :: nz_fixed_sfc, k, nzf(4) + integer :: k, nzf(4) real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate, which may be [m] ! or [Z ~> m] or [H ~> m or kg m-2] or [R ~> kg m-3] or other units. real, dimension(:), allocatable :: h_max ! Maximum layer thicknesses [H ~> m or kg m-2] @@ -489,7 +485,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (coordinateMode(coord_mode) == REGRIDDING_ZSTAR .or. & coordinateMode(coord_mode) == REGRIDDING_HYCOM1 .or. & coordinateMode(coord_mode) == REGRIDDING_HYBGEN .or. & - coordinateMode(coord_mode) == REGRIDDING_SLIGHT .or. & coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then ! Adjust target grid to be consistent with maximum_depth tmpReal = sum( dz(:) ) @@ -597,49 +592,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m default=.false.) endif - if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then - ! Set SLight-specific regridding parameters. - call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & - "The nominal thickness of fixed thickness near-surface "//& - "layers with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) - call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & - "The number of fixed-depth surface layers with the SLight "//& - "coordinate.", units="nondimensional", default=2) - call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & - "The thickness of the surface region over which to average "//& - "when calculating the density to use to define the interior "//& - "with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) - call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & - "The number of layers to offset the surface density when "//& - "defining where the interior ocean starts with SLight.", & - units="nondimensional", default=2.0) - call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & - "If true, identify regions above the reference pressure "//& - "where the reference pressure systematically underestimates "//& - "the stratification and use this in the definition of the "//& - "interior with the SLight coordinate.", default=.false.) - - call set_regrid_params(CS, dz_min_surface=dz_fixed_sfc, & - nz_fixed_surface=nz_fixed_sfc, Rho_ML_avg_depth=Rho_avg_depth, & - nlay_ML_to_interior=nlay_sfc_int, fix_haloclines=fix_haloclines) - if (fix_haloclines) then - ! Set additional parameters related to SLIGHT_FIX_HALOCLINES. - call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, & - "A length scale over which to smooth the temperature and "//& - "salinity before identifying erroneously unstable haloclines.", & - units="m", default=2.0, scale=GV%m_to_H) - call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, & - "A tolerance for the ratio of the stratification of the "//& - "apparent coordinate stratification to the actual value "//& - "that is used to identify erroneously unstable haloclines. "//& - "This ratio is 1 when they are equal, and sensible values "//& - "are between 0 and 0.5.", units="nondimensional", default=0.2) - call set_regrid_params(CS, halocline_filt_len=filt_len, & - halocline_strat_tol=strat_tol) - endif - - endif - if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, & "Ratio of ALE timestep to grid timescale.", units="nondim", default=1.0e-1) @@ -718,10 +670,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then call dz_function1( trim(string(6:)), dz_max ) - if ((coordinateMode(coord_mode) == REGRIDDING_SLIGHT) .and. & - (dz_fixed_sfc > 0.0)) then - do k=1,nz_fixed_sfc ; dz_max(k) = dz_fixed_sfc ; enddo - endif z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) @@ -803,7 +751,6 @@ subroutine end_regridding(CS) if (associated(CS%sigma_CS)) call end_coord_sigma(CS%sigma_CS) if (associated(CS%rho_CS)) call end_coord_rho(CS%rho_CS) if (associated(CS%hycom_CS)) call end_coord_hycom(CS%hycom_CS) - if (associated(CS%slight_CS)) call end_coord_slight(CS%slight_CS) if (associated(CS%adapt_CS)) call end_coord_adapt(CS%adapt_CS) if (associated(CS%hybgen_CS)) call end_hybgen_regrid(CS%hybgen_CS) @@ -877,9 +824,6 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, & case ( REGRIDDING_HYBGEN ) call hybgen_regrid(G, GV, G%US, h, tv, CS%hybgen_CS, dzInterface, PCM_cell) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) - case ( REGRIDDING_SLIGHT ) - call build_grid_SLight( G, GV, G%US, h, tv, dzInterface, CS ) - call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_ADAPTIVE ) call build_grid_adaptive(G, GV, G%US, h, tv, dzInterface, remapCS, CS) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) @@ -923,7 +867,7 @@ subroutine regridding_preadjust_reqs(CS, do_conv_adj, do_hybgen_unmix, hybgen_CS select case ( CS%regridding_scheme ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA, REGRIDDING_ARBITRARY, & - REGRIDDING_HYCOM1, REGRIDDING_SLIGHT, REGRIDDING_ADAPTIVE ) + REGRIDDING_HYCOM1, REGRIDDING_ADAPTIVE ) do_conv_adj = .false. ; do_hybgen_unmix = .false. case ( REGRIDDING_RHO ) do_conv_adj = .true. ; do_hybgen_unmix = .false. @@ -1671,84 +1615,6 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS) enddo ; enddo end subroutine build_grid_adaptive -!> Builds a grid that tracks density interfaces for water that is denser than -!! the surface density plus an increment of some number of layers, and uses all -!! lighter layers uniformly above this location. Note that this amounts to -!! interpolating to find the depth of an arbitrary (non-integer) interface index -!! which should make the results vary smoothly in space to the extent that the -!! surface density and interior stratification vary smoothly in space. Over -!! shallow topography, this will tend to give a uniform sigma-like coordinate. -!! For sufficiently shallow water, a minimum grid spacing is used to avoid -!! certain instabilities. -subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position - - real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure in the input column [R L2 T-2 ~> Pa] - real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(CS%nk+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - - ! Local variables - real :: depth ! Depth of the ocean relative to the mean sea surface height in thickness units [H ~> m or kg m-2] - integer :: i, j, k, nz - real :: h_neglect, h_neglect_edge - - if (CS%remap_answer_date >= 20190101) then - h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff - elseif (GV%Boussinesq) then - h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 - else - h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 - endif - - nz = GV%ke - - call assert((GV%ke == CS%nk), "build_grid_SLight is only written to work "//& - "with the same number of input and target layers.") - call assert(CS%target_density_set, "build_grid_SLight : "//& - "Target densities must be set before build_grid_SLight is called.") - - ! Build grid based on target interface densities - do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) then - - depth = (G%bathyT(i,j)+G%Z_ref) * GV%Z_to_H - z_col(1) = 0. ! Work downward rather than bottom up - do K=1,nz - z_col(K+1) = z_col(K) + h(i,j,k) - p_col(k) = tv%P_Ref + CS%compressibility_fraction * & - ( 0.5 * ( z_col(K) + z_col(K+1) ) * (GV%H_to_RZ*GV%g_Earth) - tv%P_Ref ) - enddo - - call build_slight_column(CS%slight_CS, tv%eqn_of_state, GV%H_to_RZ*GV%g_Earth, & - GV%H_subroundoff, nz, depth, h(i, j, :), & - tv%T(i, j, :), tv%S(i, j, :), p_col, z_col, z_col_new, & - h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) - - ! Calculate the final change in grid position after blending new and old grids - call filtered_grid_motion( CS, nz, z_col, z_col_new, dz_col ) - do K=1,nz+1 ; dzInterface(i,j,K) = -dz_col(K) ; enddo -#ifdef __DO_SAFETY_CHECKS__ - if (dzInterface(i,j,1) /= 0.) stop 'build_grid_SLight: Surface moved?!' - if (dzInterface(i,j,nz+1) /= 0.) stop 'build_grid_SLight: Bottom moved?!' -#endif - - ! This adjusts things robust to round-off errors - call adjust_interface_motion( CS, nz, h(i,j,:), dzInterface(i,j,:) ) - - else ! on land - dzInterface(i,j,:) = 0. - endif ! mask2dT - enddo ; enddo ! i,j - -end subroutine build_grid_SLight - !> Adjust dz_Interface to ensure non-negative future thicknesses subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -2042,7 +1908,7 @@ function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) scheme = coordinateMode(coordMode) select case ( scheme ) - case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_SLIGHT, & + case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, & REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_ADAPTIVE ) uniformResolution(:) = maxDepth / real(nk) @@ -2085,9 +1951,6 @@ subroutine initCoord(CS, GV, US, coord_mode, param_file) CS%interp_CS) case (REGRIDDING_HYBGEN) call init_hybgen_regrid(CS%hybgen_CS, GV, US, param_file) - case (REGRIDDING_SLIGHT) - call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, & - CS%interp_CS, GV%m_to_H) case (REGRIDDING_ADAPTIVE) call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution, GV%m_to_H, US%kg_m3_to_R) end select @@ -2181,8 +2044,6 @@ subroutine set_regrid_max_depths( CS, max_depths, units_to_H ) select case (CS%regridding_scheme) case (REGRIDDING_HYCOM1) call set_hycom_params(CS%hycom_CS, max_interface_depths=CS%max_interface_depths) - case (REGRIDDING_SLIGHT) - call set_slight_params(CS%slight_CS, max_interface_depths=CS%max_interface_depths) end select end subroutine set_regrid_max_depths @@ -2207,8 +2068,6 @@ subroutine set_regrid_max_thickness( CS, max_h, units_to_H ) select case (CS%regridding_scheme) case (REGRIDDING_HYCOM1) call set_hycom_params(CS%hycom_CS, max_layer_thickness=CS%max_layer_thickness) - case (REGRIDDING_SLIGHT) - call set_slight_params(CS%slight_CS, max_layer_thickness=CS%max_layer_thickness) end select end subroutine set_regrid_max_thickness @@ -2320,7 +2179,7 @@ function getCoordinateUnits( CS ) character(len=20) :: getCoordinateUnits select case ( CS%regridding_scheme ) - case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_SLIGHT, & + case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, & REGRIDDING_ADAPTIVE ) getCoordinateUnits = 'meter' case ( REGRIDDING_SIGMA_SHELF_ZSTAR ) @@ -2361,8 +2220,6 @@ function getCoordinateShortName( CS ) getCoordinateShortName = 'z-rho' case ( REGRIDDING_HYBGEN ) getCoordinateShortName = 'hybrid' - case ( REGRIDDING_SLIGHT ) - getCoordinateShortName = 's-rho' case ( REGRIDDING_ADAPTIVE ) getCoordinateShortName = 'adaptive' case default @@ -2375,8 +2232,7 @@ end function getCoordinateShortName !> Can be used to set any of the parameters for MOM_regridding. subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_grid_weight, & interp_scheme, depth_of_time_filter_shallow, depth_of_time_filter_deep, & - compress_fraction, ref_pressure, dz_min_surface, nz_fixed_surface, Rho_ML_avg_depth, & - nlay_ML_to_interior, fix_haloclines, halocline_filt_len, halocline_strat_tol, & + compress_fraction, ref_pressure, & integrate_downward_for_e, remap_answers_2018, remap_answer_date, & adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin, adaptDrho0) type(regridding_CS), intent(inout) :: CS !< Regridding control structure @@ -2390,18 +2246,6 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density [nondim] real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent !! coordinates [R L2 T-2 ~> Pa] - real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost - !! SLight_nkml_min layers [H ~> m or kg m-2] - integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model - real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential - !! density [H ~> m or kg m-2] - real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find - !! resolved stratification [nondim] - logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate - real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for - !! spuriously unstable water mass profiles [H ~> m or kg m-2] - real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic - !! halocline region. logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward !! from the top. logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions @@ -2466,18 +2310,6 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri call set_hycom_params(CS%hycom_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYBGEN) ! Do nothing for now. - case (REGRIDDING_SLIGHT) - if (present(min_thickness)) call set_slight_params(CS%slight_CS, min_thickness=min_thickness) - if (present(dz_min_surface)) call set_slight_params(CS%slight_CS, dz_ml_min=dz_min_surface) - if (present(nz_fixed_surface)) call set_slight_params(CS%slight_CS, nz_fixed_surface=nz_fixed_surface) - if (present(Rho_ML_avg_depth)) call set_slight_params(CS%slight_CS, Rho_ML_avg_depth=Rho_ML_avg_depth) - if (present(nlay_ML_to_interior)) call set_slight_params(CS%slight_CS, nlay_ML_offset=nlay_ML_to_interior) - if (present(fix_haloclines)) call set_slight_params(CS%slight_CS, fix_haloclines=fix_haloclines) - if (present(halocline_filt_len)) call set_slight_params(CS%slight_CS, halocline_filter_length=halocline_filt_len) - if (present(halocline_strat_tol)) call set_slight_params(CS%slight_CS, halocline_strat_tol=halocline_strat_tol) - if (present(compress_fraction)) call set_slight_params(CS%slight_CS, compressibility_fraction=compress_fraction) - if (associated(CS%slight_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & - call set_slight_params(CS%slight_CS, interp_CS=CS%interp_CS) case (REGRIDDING_ADAPTIVE) if (present(adaptTimeRatio)) call set_adapt_params(CS%adapt_CS, adaptTimeRatio=adaptTimeRatio) if (present(adaptZoom)) call set_adapt_params(CS%adapt_CS, adaptZoom=adaptZoom) @@ -2535,7 +2367,7 @@ function getStaticThickness( CS, SSH, depth ) select case ( CS%regridding_scheme ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, & - REGRIDDING_SLIGHT, REGRIDDING_ADAPTIVE ) + REGRIDDING_ADAPTIVE ) if (depth>0.) then z = ssh do k = 1, CS%nk diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 deleted file mode 100644 index 4b4ac8a153..0000000000 --- a/src/ALE/coord_slight.F90 +++ /dev/null @@ -1,733 +0,0 @@ -!> Regrid columns for the SLight coordinate -module coord_slight - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL -use MOM_EOS, only : EOS_type, calculate_compress -use MOM_EOS, only : calculate_density, calculate_density_derivs -use regrid_interp, only : interp_CS_type, regridding_set_ppolys -use regrid_interp, only : NR_ITERATIONS, NR_TOLERANCE, DEGREE_MAX - -implicit none ; private - -!> Control structure containing required parameters for the SLight coordinate -type, public :: slight_CS ; private - - !> Number of layers/levels - integer :: nk - - !> Minimum thickness allowed when building the new grid through regridding [H ~> m or kg m-2] - real :: min_thickness - - !> Reference pressure for potential density calculations [R L2 T-2 ~> Pa] - real :: ref_pressure - - !> Fraction (between 0 and 1) of compressibility to add to potential density - !! profiles when interpolating for target grid positions. [nondim] - real :: compressibility_fraction - - ! The following 4 parameters were introduced for use with the SLight coordinate: - !> Depth over which to average to determine the mixed layer potential density [H ~> m or kg m-2] - real :: Rho_ML_avg_depth - - !> Number of layers to offset the mixed layer density to find resolved stratification [nondim] - real :: nlay_ml_offset - - !> The number of fixed-thickness layers at the top of the model - integer :: nz_fixed_surface = 2 - - !> The fixed resolution in the topmost SLight_nkml_min layers [H ~> m or kg m-2] - real :: dz_ml_min - - !> If true, detect regions with much weaker stratification in the coordinate - !! than based on in-situ density, and use a stretched coordinate there. - logical :: fix_haloclines = .false. - - !> A length scale over which to filter T & S when looking for spuriously - !! unstable water mass profiles [H ~> m or kg m-2]. - real :: halocline_filter_length - - !> A value of the stratification ratio that defines a problematic halocline region [nondim]. - real :: halocline_strat_tol - - !> Nominal density of interfaces [R ~> kg m-3]. - real, allocatable, dimension(:) :: target_density - - !> Maximum depths of interfaces [H ~> m or kg m-2]. - real, allocatable, dimension(:) :: max_interface_depths - - !> Maximum thicknesses of layers [H ~> m or kg m-2]. - real, allocatable, dimension(:) :: max_layer_thickness - - !> Interpolation control structure - type(interp_CS_type) :: interp_CS -end type slight_CS - -public init_coord_slight, set_slight_params, build_slight_column, end_coord_slight - -contains - -!> Initialise a slight_CS with pointers to parameters -subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H) - type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk !< Number of layers in the grid - real, intent(in) :: ref_pressure !< Coordinate reference pressure [R L2 T-2 ~> Pa] - real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [R ~> kg m-3] - type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation - real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses - - real :: m_to_H_rescale ! A unit conversion factor. - - if (associated(CS)) call MOM_error(FATAL, "init_coord_slight: CS already associated!") - allocate(CS) - allocate(CS%target_density(nk+1)) - - m_to_H_rescale = 1.0 ; if (present(m_to_H)) m_to_H_rescale = m_to_H - - CS%nk = nk - CS%ref_pressure = ref_pressure - CS%target_density(:) = target_density(:) - CS%interp_CS = interp_CS - - ! Set real parameter default values - CS%compressibility_fraction = 0. ! Nondim. - CS%Rho_ML_avg_depth = 1.0 * m_to_H_rescale - CS%nlay_ml_offset = 2.0 ! Nondim. - CS%dz_ml_min = 1.0 * m_to_H_rescale - CS%halocline_filter_length = 2.0 * m_to_H_rescale - CS%halocline_strat_tol = 0.25 ! Nondim. - -end subroutine init_coord_slight - -!> This subroutine deallocates memory in the control structure for the coord_slight module -subroutine end_coord_slight(CS) - type(slight_CS), pointer :: CS !< Coordinate control structure - - ! nothing to do - if (.not. associated(CS)) return - deallocate(CS%target_density) - deallocate(CS) -end subroutine end_coord_slight - -!> This subroutine can be used to set the parameters for the coord_slight module -subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & - min_thickness, compressibility_fraction, dz_ml_min, & - nz_fixed_surface, Rho_ML_avg_depth, nlay_ML_offset, fix_haloclines, & - halocline_filter_length, halocline_strat_tol, interp_CS) - type(slight_CS), pointer :: CS !< Coordinate control structure - real, dimension(:), & - optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] - real, dimension(:), & - optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] - real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the - !! new grid through regridding [H ~> m or kg m-2] - real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of - !! compressibility to add to potential density profiles when - !! interpolating for target grid positions. [nondim] - real, optional, intent(in) :: dz_ml_min !< The fixed resolution in the topmost - !! SLight_nkml_min layers [H ~> m or kg m-2] - integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the - !! top of the model - real, optional, intent(in) :: Rho_ML_avg_depth !< Depth over which to average to determine - !! the mixed layer potential density [H ~> m or kg m-2] - real, optional, intent(in) :: nlay_ML_offset !< Number of layers to offset the mixed layer - !! density to find resolved stratification [nondim] - logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than - !! based on in-situ density, and use a stretched coordinate there. - real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S - !! when looking for spuriously unstable water mass profiles [H ~> m or kg m-2]. - real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that - !! defines a problematic halocline region [nondim]. - type(interp_CS_type), & - optional, intent(in) :: interp_CS !< Controls for interpolation - - if (.not. associated(CS)) call MOM_error(FATAL, "set_slight_params: CS not associated") - - if (present(max_interface_depths)) then - if (size(max_interface_depths) /= CS%nk+1) & - call MOM_error(FATAL, "set_slight_params: max_interface_depths inconsistent size") - allocate(CS%max_interface_depths(CS%nk+1)) - CS%max_interface_depths(:) = max_interface_depths(:) - endif - - if (present(max_layer_thickness)) then - if (size(max_layer_thickness) /= CS%nk) & - call MOM_error(FATAL, "set_slight_params: max_layer_thickness inconsistent size") - allocate(CS%max_layer_thickness(CS%nk)) - CS%max_layer_thickness(:) = max_layer_thickness(:) - endif - - if (present(min_thickness)) CS%min_thickness = min_thickness - if (present(compressibility_fraction)) CS%compressibility_fraction = compressibility_fraction - - if (present(dz_ml_min)) CS%dz_ml_min = dz_ml_min - if (present(nz_fixed_surface)) CS%nz_fixed_surface = nz_fixed_surface - if (present(Rho_ML_avg_depth)) CS%Rho_ML_avg_depth = Rho_ML_avg_depth - if (present(nlay_ML_offset)) CS%nlay_ML_offset = nlay_ML_offset - if (present(fix_haloclines)) CS%fix_haloclines = fix_haloclines - if (present(halocline_filter_length)) CS%halocline_filter_length = halocline_filter_length - if (present(halocline_strat_tol)) then - if (halocline_strat_tol > 1.0) call MOM_error(FATAL, "set_slight_params: "//& - "HALOCLINE_STRAT_TOL must not exceed 1.0.") - CS%halocline_strat_tol = halocline_strat_tol - endif - - if (present(interp_CS)) CS%interp_CS = interp_CS -end subroutine set_slight_params - -!> Build a SLight coordinate column -subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & - nz, depth, h_col, T_col, S_col, p_col, z_col, z_col_new, & - h_neglect, h_neglect_edge) - type(slight_CS), intent(in) :: CS !< Coordinate control structure - type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure - real, intent(in) :: H_to_pres !< A conversion factor from thicknesses to - !! scaled pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] - real, intent(in) :: H_subroundoff !< GV%H_subroundoff - integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) - real, dimension(nz), intent(in) :: T_col !< T for column [C ~> degC] - real, dimension(nz), intent(in) :: S_col !< S for column [S ~> ppt] - real, dimension(nz), intent(in) :: h_col !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(nz), intent(in) :: p_col !< Layer center pressure [R L2 T-2 ~> Pa] - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces [H ~> m or kg m-2] - real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of - !! cell reconstructions [H ~> m or kg m-2]. - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose - !! of edge value calculations [H ~> m or kg m-2]. - ! Local variables - real, dimension(nz) :: rho_col ! Layer densities [R ~> kg m-3] - real, dimension(nz) :: T_f, S_f ! Filtered layer temperature [C ~> degC] and salinity [S ~> ppt] - logical, dimension(nz+1) :: reliable ! If true, this interface is in a reliable position. - real, dimension(nz+1) :: T_int, S_int ! Temperature [C ~> degC] and salinity [S ~> ppt] interpolated to interfaces. - real, dimension(nz+1) :: rho_tmp ! A temporary density [R ~> kg m-3] - real, dimension(nz+1) :: drho_dp ! The partial derivative of density with pressure [T2 L-2 ~> kg m-3 Pa-1] - real, dimension(nz+1) :: p_IS, p_R ! Pressures [R L2 T-2 ~> Pa] - real, dimension(nz+1) :: drhoIS_dT ! The partial derivative of in situ density with temperature - ! in [R C-1 ~> kg m-3 degC-1] - real, dimension(nz+1) :: drhoIS_dS ! The partial derivative of in situ density with salinity - ! in [R S-1 ~> kg m-3 ppt-1] - real, dimension(nz+1) :: drhoR_dT ! The partial derivative of reference density with temperature - ! in [R C-1 ~> kg m-3 degC-1] - real, dimension(nz+1) :: drhoR_dS ! The partial derivative of reference density with salinity - ! in [R S-1 ~> kg m-3 ppt-1] - real, dimension(nz+1) :: strat_rat - real :: H_to_cPa ! A conversion factor from thicknesses to the compressibility fraction times - ! the units of pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] - real :: drIS, drR ! In situ and reference density differences [R ~> kg m-3] - real :: Fn_now, I_HStol, Fn_zero_val ! Nondimensional variables [nondim] - real :: z_int_unst ! The depth where the stratification allows the interior grid to start [H ~> m or kg m-2] - real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. - real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. - real :: wgt, cowgt ! A weight and its complement [nondim]. - real :: rho_ml_av ! The average potential density in a near-surface region [R ~> kg m-3]. - real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. - real :: rho_x_z ! A cumulative integral of a density [R H ~> kg m-2 or kg2 m-5]. - real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. - real :: k_interior ! The (real) value of k where the interior grid starts [nondim]. - real :: k_int2 ! The (real) value of k where the interior grid starts [nondim]. - real :: z_interior ! The depth where the interior grid starts [H ~> m or kg m-2]. - real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end [H ~> m or kg m-2]. - real :: dz_dk ! The thickness of layers between the fixed-thickness - ! near-surface layars and the interior [H ~> m or kg m-2]. - real :: Lfilt ! A filtering lengthscale [H ~> m or kg m-2]. - logical :: maximum_depths_set ! If true, the maximum depths of interface have been set. - logical :: maximum_h_set ! If true, the maximum layer thicknesses have been set. - real :: h_tr, b_denom_1, b1, d1 ! Temporary variables used by the tridiagonal solver. - real, dimension(nz) :: c1 ! Temporary variables used by the tridiagonal solver. - integer :: kur1, kur2 ! The indicies at the top and bottom of an unreliable region. - integer :: kur_ss ! The index to start with in the search for the next unstable region. - integer :: k, nkml - - maximum_depths_set = allocated(CS%max_interface_depths) - maximum_h_set = allocated(CS%max_layer_thickness) - - if (z_col(nz+1) - z_col(1) < nz*CS%min_thickness) then - ! This is a nearly massless total depth, so distribute the water evenly. - dz = (z_col(nz+1) - z_col(1)) / real(nz) - do K=2,nz ; z_col_new(K) = z_col(1) + dz*real(K-1) ; enddo - else - call calculate_density(T_col, S_col, p_col, rho_col, eqn_of_state) - - ! Find the locations of the target potential densities, flagging - ! locations in apparently unstable regions as not reliable. - call rho_interfaces_col(rho_col, h_col, z_col, CS%target_density, nz, & - z_col_new, CS, reliable, debug=.true., & - h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) - - ! Ensure that the interfaces are at least CS%min_thickness apart. - if (CS%min_thickness > 0.0) then - ! Move down interfaces below overly thin layers. - do K=2,nz ; if (z_col_new(K) < z_col_new(K-1) + CS%min_thickness) then - z_col_new(K) = z_col_new(K-1) + CS%min_thickness - endif ; enddo - ! Now move up any interfaces that are too close to the bottom. - do K=nz,2,-1 ; if (z_col_new(K) > z_col_new(K+1) - CS%min_thickness) then - z_col_new(K) = z_col_new(K+1) - CS%min_thickness - else - exit ! No more interfaces can be too close to the bottom. - endif ; enddo - endif - - ! Fix up the unreliable regions. - kur_ss = 2 ! reliable(1) and reliable(nz+1) must always be true. - do - ! Search for the uppermost unreliable interface postion. - kur1 = nz+2 - do K=kur_ss,nz ; if (.not.reliable(K)) then - kur1 = K ; exit - endif ; enddo - if (kur1 > nz) exit ! Everything is now reliable. - - kur2 = kur1-1 ! For error checking. - do K=kur1+1,nz+1 ; if (reliable(K)) then - kur2 = K-1 ; kur_ss = K ; exit - endif ; enddo - if (kur2 < kur1) call MOM_error(FATAL, "Bad unreliable range.") - - dz_ur = z_col_new(kur2+1) - z_col_new(kur1-1) - ! drho = CS%target_density(kur2+1) - CS%target_density(kur1-1) - ! Perhaps reset the wgt and cowgt depending on how bad the old interface - ! locations were. - wgt = 1.0 ; cowgt = 0.0 ! = 1.0-wgt - do K=kur1,kur2 - z_col_new(K) = cowgt*z_col_new(K) + & - wgt * (z_col_new(kur1-1) + dz_ur*(K - (kur1-1)) / ((kur2 - kur1) + 2)) - enddo - enddo - - ! Determine which interfaces are in the s-space region and the depth extent - ! of this region. - z_wt = 0.0 ; rho_x_z = 0.0 - H_ml_av = CS%Rho_ml_avg_depth - do k=1,nz - if (z_wt + h_col(k) >= H_ml_av) then - rho_x_z = rho_x_z + rho_col(k) * (H_ml_av - z_wt) - z_wt = H_ml_av - exit - else - rho_x_z = rho_x_z + rho_col(k) * h_col(k) - z_wt = z_wt + h_col(k) - endif - enddo - if (z_wt > 0.0) rho_ml_av = rho_x_z / z_wt - - nkml = CS%nz_fixed_surface - ! Find the interface that matches rho_ml_av. - if (rho_ml_av <= CS%target_density(nkml)) then - k_interior = CS%nlay_ml_offset + real(nkml) - elseif (rho_ml_av > CS%target_density(nz+1)) then - k_interior = real(nz+1) - else ; do K=nkml,nz - if ((rho_ml_av >= CS%target_density(K)) .and. & - (rho_ml_av < CS%target_density(K+1))) then - k_interior = (CS%nlay_ml_offset + K) + & - (rho_ml_av - CS%target_density(K)) / & - (CS%target_density(K+1) - CS%target_density(K)) - exit - endif - enddo ; endif - if (k_interior > real(nz+1)) k_interior = real(nz+1) - - ! Linearly interpolate to find z_interior. This could be made more sophisticated. - K = int(ceiling(k_interior)) - z_interior = (K-k_interior)*z_col_new(K-1) + (1.0+(k_interior-K))*z_col_new(K) - - if (CS%fix_haloclines) then - ! ! Identify regions above the reference pressure where the chosen - ! ! potential density significantly underestimates the actual - ! ! stratification, and use these to find a second estimate of - ! ! z_int_unst and k_interior. - - if (CS%halocline_filter_length > 0.0) then - Lfilt = CS%halocline_filter_length - - ! Filter the temperature and salnity with a fixed lengthscale. - h_tr = h_col(1) + H_subroundoff - b1 = 1.0 / (h_tr + Lfilt) ; d1 = h_tr * b1 - T_f(1) = (b1*h_tr)*T_col(1) ; S_f(1) = (b1*h_tr)*S_col(1) - do k=2,nz - c1(k) = Lfilt * b1 - h_tr = h_col(k) + H_subroundoff ; b_denom_1 = h_tr + d1*Lfilt - b1 = 1.0 / (b_denom_1 + Lfilt) ; d1 = b_denom_1 * b1 - T_f(k) = b1 * (h_tr*T_col(k) + Lfilt*T_f(k-1)) - S_f(k) = b1 * (h_tr*S_col(k) + Lfilt*S_f(k-1)) - enddo - do k=nz-1,1,-1 - T_f(k) = T_f(k) + c1(k+1)*T_f(k+1) ; S_f(k) = S_f(k) + c1(k+1)*S_f(k+1) - enddo - else - do k=1,nz ; T_f(k) = T_col(k) ; S_f(k) = S_col(k) ; enddo - endif - - T_int(1) = T_f(1) ; S_int(1) = S_f(1) - do K=2,nz - T_int(K) = 0.5*(T_f(k-1) + T_f(k)) ; S_int(K) = 0.5*(S_f(k-1) + S_f(k)) - p_IS(K) = z_col(K) * H_to_pres - p_R(K) = CS%ref_pressure + CS%compressibility_fraction * ( p_IS(K) - CS%ref_pressure ) - enddo - T_int(nz+1) = T_f(nz) ; S_int(nz+1) = S_f(nz) - p_IS(nz+1) = z_col(nz+1) * H_to_pres - call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, & - eqn_of_state, (/2,nz/) ) - call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, & - eqn_of_state, (/2,nz/) ) - if (CS%compressibility_fraction > 0.0) then - call calculate_compress(T_int, S_int, p_R(:), rho_tmp, drho_dp, eqn_of_state, (/2,nz/)) - else - do K=2,nz ; drho_dp(K) = 0.0 ; enddo - endif - - H_to_cPa = CS%compressibility_fraction * H_to_pres - strat_rat(1) = 1.0 - do K=2,nz - drIS = drhoIS_dT(K) * (T_f(k) - T_f(k-1)) + & - drhoIS_dS(K) * (S_f(k) - S_f(k-1)) - drR = (drhoR_dT(K) * (T_f(k) - T_f(k-1)) + & - drhoR_dS(K) * (S_f(k) - S_f(k-1))) + & - drho_dp(K) * (H_to_cPa*0.5*(h_col(k) + h_col(k-1))) - - if (drIS <= 0.0) then - strat_rat(K) = 2.0 ! Maybe do this? => ; if (drR < 0.0) strat_rat(K) = -2.0 - else - strat_rat(K) = 2.0*max(drR,0.0) / (drIS + abs(drR)) - endif - enddo - strat_rat(nz+1) = 1.0 - - z_int_unst = 0.0 ; Fn_now = 0.0 - Fn_zero_val = min(2.0*CS%halocline_strat_tol, & - 0.5*(1.0 + CS%halocline_strat_tol)) - if (CS%halocline_strat_tol > 0.0) then - ! Use Adcroft's reciprocal rule. - I_HStol = 0.0 ; if (Fn_zero_val - CS%halocline_strat_tol > 0.0) & - I_HStol = 1.0 / (Fn_zero_val - CS%halocline_strat_tol) - do k=nz,1,-1 ; if (CS%ref_pressure > p_IS(k+1)) then - z_int_unst = z_int_unst + Fn_now * h_col(k) - if (strat_rat(K) <= Fn_zero_val) then - if (strat_rat(K) <= CS%halocline_strat_tol) then ; Fn_now = 1.0 - else - Fn_now = max(Fn_now, (Fn_zero_val - strat_rat(K)) * I_HStol) - endif - endif - endif ; enddo - else - do k=nz,1,-1 ; if (CS%ref_pressure > p_IS(k+1)) then - z_int_unst = z_int_unst + Fn_now * h_col(k) - if (strat_rat(K) <= CS%halocline_strat_tol) Fn_now = 1.0 - endif ; enddo - endif - - if (z_interior < z_int_unst) then - ! Find a second estimate of the extent of the s-coordinate region. - kur1 = max(int(ceiling(k_interior)),2) - if (z_col_new(kur1-1) < z_interior) then - k_int2 = kur1 - do K = kur1,nz+1 ; if (z_col_new(K) >= z_int_unst) then - ! This is linear interpolation again. - if (z_col_new(K-1) >= z_int_unst) & - call MOM_error(FATAL,"build_grid_SLight, bad halocline structure.") - k_int2 = real(K-1) + (z_int_unst - z_col_new(K-1)) / & - (z_col_new(K) - z_col_new(K-1)) - exit - endif ; enddo - if (z_col_new(nz+1) < z_int_unst) then - ! This should be unnecessary. - z_int_unst = z_col_new(nz+1) ; k_int2 = real(nz+1) - endif - - ! Now take the larger values. - if (k_int2 > k_interior) then - k_interior = k_int2 ; z_interior = z_int_unst - endif - endif - endif - endif ! fix_haloclines - - z_col_new(1) = 0.0 - do K=2,nkml+1 - z_col_new(K) = min((K-1)*CS%dz_ml_min, & - z_col_new(nz+1) - CS%min_thickness*(nz+1-K)) - enddo - z_ml_fix = z_col_new(nkml+1) - if (z_interior > z_ml_fix) then - dz_dk = (z_interior - z_ml_fix) / (k_interior - (nkml+1)) - do K=nkml+2,int(floor(k_interior)) - z_col_new(K) = z_ml_fix + dz_dk * (K - (nkml+1)) - enddo - else ! The fixed-thickness z-region penetrates into the interior. - do K=nkml+2,nz - if (z_col_new(K) <= z_col_new(CS%nz_fixed_surface+1)) then - z_col_new(K) = z_col_new(CS%nz_fixed_surface+1) - else ; exit ; endif - enddo - endif - - if (maximum_depths_set .and. maximum_h_set) then ; do k=2,nz - ! The loop bounds are 2 & nz so the top and bottom interfaces do not move. - ! Recall that z_col_new is positive downward. - z_col_new(K) = min(z_col_new(K), CS%max_interface_depths(K), & - z_col_new(K-1) + CS%max_layer_thickness(k-1)) - enddo ; elseif (maximum_depths_set) then ; do K=2,nz - z_col_new(K) = min(z_col_new(K), CS%max_interface_depths(K)) - enddo ; elseif (maximum_h_set) then ; do k=2,nz - z_col_new(K) = min(z_col_new(K), z_col_new(K-1) + CS%max_layer_thickness(k-1)) - enddo ; endif - - endif ! Total thickness exceeds nz*CS%min_thickness. - -end subroutine build_slight_column - -!> Finds the new interface locations in a column of water that match the -!! prescribed target densities. -subroutine rho_interfaces_col(rho_col, h_col, z_col, rho_tgt, nz, z_col_new, & - CS, reliable, debug, h_neglect, h_neglect_edge) - integer, intent(in) :: nz !< Number of layers - real, dimension(nz), intent(in) :: rho_col !< Initial layer reference densities [R ~> kg m-3]. - real, dimension(nz), intent(in) :: h_col !< Initial layer thicknesses [H ~> m or kg m-2]. - real, dimension(nz+1), intent(in) :: z_col !< Initial interface heights [H ~> m or kg m-2]. - real, dimension(nz+1), intent(in) :: rho_tgt !< Interface target densities. - real, dimension(nz+1), intent(inout) :: z_col_new !< New interface heights [H ~> m or kg m-2]. - type(slight_CS), intent(in) :: CS !< Coordinate control structure - logical, dimension(nz+1), intent(inout) :: reliable !< If true, the interface positions - !! are well defined from a stable region. - logical, optional, intent(in) :: debug !< If present and true, do debugging checks. - real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of - !! cell reconstructions [H ~> m or kg m-2] - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose - !! of edge value calculations [H ~> m or kg m-2] - - real, dimension(nz+1) :: ru_max_int ! The maximum and minimum densities in - real, dimension(nz+1) :: ru_min_int ! an unstable region around an interface [R ~> kg m-3]. - real, dimension(nz) :: ru_max_lay ! The maximum and minimum densities in - real, dimension(nz) :: ru_min_lay ! an unstable region containing a layer [R ~> kg m-3]. - real, dimension(nz,2) :: ppoly_i_E ! Edge value of polynomial [R ~> kg m-3] - real, dimension(nz,2) :: ppoly_i_S ! Edge slope of polynomial [R H-1 ~> kg m-4 or m-1] - real, dimension(nz,DEGREE_MAX+1) :: ppoly_i_coefficients ! Coefficients of polynomial [R ~> kg m-3] - logical, dimension(nz) :: unstable_lay ! If true, this layer is in an unstable region. - logical, dimension(nz+1) :: unstable_int ! If true, this interface is in an unstable region. - real :: rt ! The current target density [R ~> kg m-3]. - real :: zf ! The fractional z-position within a layer of the target density [nondim]. - real :: rfn ! The target density relative to the interpolated density [R ~> kg m-3] - real :: a(5) ! Coefficients of a local polynomial minus the target density [R ~> kg m-3]. - real :: zf1, zf2 ! Two previous estimates of zf [nondim] - real :: rfn1, rfn2 ! Values of rfn at zf1 and zf2 [R ~> kg m-3] - real :: drfn_dzf ! The partial derivative of rfn with zf [R ~> kg m-3] - real :: sgn, delta_zf, zf_prev ! [nondim] - real :: tol ! The tolerance for convergence of zf [nondim] - logical :: k_found ! If true, the position has been found. - integer :: k_layer ! The index of the stable layer containing an interface. - integer :: ppoly_degree - integer :: k, k1, k1_min, itt, max_itt, m - - real :: z_sgn ! 1 or -1, depending on whether z increases with increasing K. - logical :: debugging - - debugging = .false. ; if (present(debug)) debugging = debug - max_itt = NR_ITERATIONS - tol = NR_TOLERANCE - - z_sgn = 1.0 ; if ( z_col(1) > z_col(nz+1) ) z_sgn = -1.0 - if (debugging) then - do K=1,nz - if (abs((z_col(K+1) - z_col(K)) - z_sgn*h_col(k)) > & - 1.0e-14*(abs(z_col(K+1)) + abs(z_col(K)) + abs(h_col(k))) ) & - call MOM_error(FATAL, "rho_interfaces_col: Inconsistent z_col and h_col") - enddo - endif - - if ( z_col(1) == z_col(nz+1) ) then - ! This is a massless column! - do K=1,nz+1 ; z_col_new(K) = z_col(1) ; reliable(K) = .true. ; enddo - return - endif - - ! This sets up the piecewise polynomials based on the rho_col profile. - call regridding_set_ppolys(CS%interp_CS, rho_col, nz, h_col, ppoly_i_E, ppoly_i_S, & - ppoly_i_coefficients, ppoly_degree, h_neglect, h_neglect_edge) - - ! Determine the density ranges of unstably stratified segments. - ! Interfaces that start out in an unstably stratified segment can - ! only escape if they are outside of the bounds of that segment, and no - ! interfaces are ever mapped into an unstable segment. - unstable_int(1) = .false. - ru_max_int(1) = ppoly_i_E(1,1) - - unstable_lay(1) = (ppoly_i_E(1,1) > ppoly_i_E(1,2)) - ru_max_lay(1) = max(ppoly_i_E(1,1), ppoly_i_E(1,2)) - - do K=2,nz - unstable_int(K) = (ppoly_i_E(k-1,2) > ppoly_i_E(k,1)) - ru_max_int(K) = max(ppoly_i_E(k-1,2), ppoly_i_E(k,1)) - ru_min_int(K) = min(ppoly_i_E(k-1,2), ppoly_i_E(k,1)) - if (unstable_int(K) .and. unstable_lay(k-1)) & - ru_max_int(K) = max(ru_max_lay(k-1), ru_max_int(K)) - - unstable_lay(k) = (ppoly_i_E(k,1) > ppoly_i_E(k,2)) - ru_max_lay(k) = max(ppoly_i_E(k,1), ppoly_i_E(k,2)) - ru_min_lay(k) = min(ppoly_i_E(k,1), ppoly_i_E(k,2)) - if (unstable_lay(k) .and. unstable_int(K)) & - ru_max_lay(k) = max(ru_max_int(K), ru_max_lay(k)) - enddo - unstable_int(nz+1) = .false. - ru_min_int(nz+1) = ppoly_i_E(nz,2) - - do K=nz,1,-1 - if (unstable_lay(k) .and. unstable_int(K+1)) & - ru_min_lay(k) = min(ru_min_int(K+1), ru_min_lay(k)) - - if (unstable_int(K) .and. unstable_lay(k)) & - ru_min_int(K) = min(ru_min_lay(k), ru_min_int(K)) - enddo - - z_col_new(1) = z_col(1) ; reliable(1) = .true. - k1_min = 1 - do K=2,nz ! Find the locations of the various target densities for the interfaces. - rt = rho_tgt(K) - k_layer = -1 - k_found = .false. - - ! Many light layers are found at the top, so start there. - if (rt <= ppoly_i_E(k1_min,1)) then - z_col_new(K) = z_col(k1_min) - k_found = .true. - ! Do not change k1_min for the next layer. - elseif (k1_min == nz+1) then - z_col_new(K) = z_col(nz+1) - else - ! Start with the previous location and search outward. - if (unstable_int(K) .and. (rt >= ru_min_int(K)) .and. (rt <= ru_max_int(K))) then - ! This interface started in an unstable region and should not move due to remapping. - z_col_new(K) = z_col(K) ; reliable(K) = .false. - k1_min = K ; k_found = .true. - elseif ((rt >= ppoly_i_E(k-1,2)) .and. (rt <= ppoly_i_E(k,1))) then - ! This interface is already in the right place and does not move. - z_col_new(K) = z_col(K) ; reliable(K) = .true. - k1_min = K ; k_found = .true. - elseif (rt < ppoly_i_E(k-1,2)) then ! Search upward - do k1=K-1,k1_min,-1 - ! Check whether rt is in layer k. - if ((rt < ppoly_i_E(k1,2)) .and. (rt > ppoly_i_E(k1,1))) then - ! rt is in layer k. - k_layer = k1 - k1_min = k1 ; k_found = .true. ; exit - elseif (unstable_lay(k1) .and. (rt >= ru_min_lay(k1)) .and. (rt <= ru_max_lay(K1))) then - ! rt would be found at unstable layer that it can not penetrate. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1+1) ; reliable(K) = .false. - k1_min = k1 ; k_found = .true. ; exit - endif - ! Check whether rt is at interface K. - if (k1 > 1) then ; if ((rt <= ppoly_i_E(k1,1)) .and. (rt >= ppoly_i_E(k1-1,2))) then - ! rt is at interface K1 - z_col_new(K) = z_col(K1) ; reliable(K) = .true. - k1_min = k1 ; k_found = .true. ; exit - elseif (unstable_int(K1) .and. (rt >= ru_min_int(k1)) .and. (rt <= ru_max_int(K1))) then - ! rt would be found at an unstable interface that it can not pass. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1) ; reliable(K) = .false. - k1_min = k1 ; k_found = .true. ; exit - endif ; endif - enddo - - if (.not.k_found) then - ! This should not happen unless k1_min = 1. - if (k1_min < 2) then - z_col_new(K) = z_col(k1_min) - else - z_col_new(K) = z_col(k1_min) - endif - endif - - else ! Search downward - do k1=K,nz - if ((rt < ppoly_i_E(k1,2)) .and. (rt > ppoly_i_E(k1,1))) then - ! rt is in layer k. - k_layer = k1 - k1_min = k1 ; k_found = .true. ; exit - elseif (unstable_lay(k1) .and. (rt >= ru_min_lay(k1)) .and. (rt <= ru_max_lay(K1))) then - ! rt would be found at unstable layer that it can not penetrate. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1) - reliable(K) = .false. - k1_min = k1 ; k_found = .true. ; exit - endif - if (k1 < nz) then ; if ((rt <= ppoly_i_E(k1+1,1)) .and. (rt >= ppoly_i_E(k1,2))) then - ! rt is at interface K1+1 - - z_col_new(K) = z_col(K1+1) ; reliable(K) = .true. - k1_min = k1+1 ; k_found = .true. ; exit - elseif (unstable_int(K1+1) .and. (rt >= ru_min_int(k1+1)) .and. (rt <= ru_max_int(K1+1))) then - ! rt would be found at an unstable interface that it can not pass. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1+1) - reliable(K) = .false. - k1_min = k1+1 ; k_found = .true. ; exit - endif ; endif - enddo - if (.not.k_found) then - z_col_new(K) = z_col(nz+1) - if (rt >= ppoly_i_E(nz,2)) then - reliable(K) = .true. - else - reliable(K) = .false. - endif - endif - endif - - if (k_layer > 0) then ! The new location is inside of layer k_layer. - ! Note that this is coded assuming that this layer is stably stratified. - if (.not.(ppoly_i_E(k1,2) > ppoly_i_E(k1,1))) call MOM_error(FATAL, & - "build_grid_SLight: Erroneously searching for an interface in an unstratified layer.") - - ! Use the false position method to find the location (degree <= 1) or the first guess. - zf = (rt - ppoly_i_E(k1,1)) / (ppoly_i_E(k1,2) - ppoly_i_E(k1,1)) - - if (ppoly_degree > 1) then ! Iterate to find the solution. - a(:) = 0.0 ; a(1) = ppoly_i_coefficients(k_layer,1) - rt - do m=2,ppoly_degree+1 ; a(m) = ppoly_i_coefficients(k_layer,m) ; enddo - ! Bracket the root. - zf1 = 0.0 ; rfn1 = a(1) - zf2 = 1.0 ; rfn2 = a(1) + (a(2) + (a(3) + (a(4) + a(5)))) - if (rfn1 * rfn2 > 0.0) call MOM_error(FATAL, "build_grid_SLight: Bad bracketing.") - - do itt=1,max_itt - rfn = a(1) + zf*(a(2) + zf*(a(3) + zf*(a(4) + zf*a(5)))) - ! Reset one of the ends of the bracket. - if (rfn * rfn1 > 0.0) then - zf1 = zf ; rfn1 = rfn - else - zf2 = zf ; rfn2 = rfn - endif - if (rfn1 == rfn2) exit - - drfn_dzf = (a(2) + zf*(2.0*a(3) + zf*(3.0*a(4) + zf*4.0*a(5)))) - sgn = 1.0 ; if (drfn_dzf < 0.0) sgn = -1.0 - - if ((sgn*(zf - rfn) >= zf1 * abs(drfn_dzf)) .and. & - (sgn*(zf - rfn) <= zf2 * abs(drfn_dzf))) then - delta_zf = -rfn / drfn_dzf - zf = zf + delta_zf - else ! Newton's method goes out of bounds, so use a false position method estimate - zf_prev = zf - zf = ( rfn2 * zf1 - rfn1 * zf2 ) / (rfn2 - rfn1) - delta_zf = zf - zf_prev - endif - - if (abs(delta_zf) < tol) exit - enddo - endif - z_col_new(K) = z_col(k_layer) + zf * z_sgn * h_col(k_layer) - reliable(K) = .true. - endif - - endif - - enddo - z_col_new(nz+1) = z_col(nz+1) ; reliable(nz+1) = .true. - -end subroutine rho_interfaces_col - -end module coord_slight diff --git a/src/ALE/regrid_consts.F90 b/src/ALE/regrid_consts.F90 index 9fe638dd5b..0c5ccf268f 100644 --- a/src/ALE/regrid_consts.F90 +++ b/src/ALE/regrid_consts.F90 @@ -16,8 +16,6 @@ module regrid_consts integer, parameter :: REGRIDDING_SIGMA = 4 !< Sigma coordinates identifier integer, parameter :: REGRIDDING_ARBITRARY = 5 !< Arbitrary coordinates identifier integer, parameter :: REGRIDDING_HYCOM1 = 6 !< Simple HyCOM coordinates without BBL -integer, parameter :: REGRIDDING_SLIGHT = 7 !< Identifier for stretched coordinates in the - !! lightest water, isopycnal below integer, parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR = 8 !< Identifiered for z* coordinates at the bottom, !! sigma-near the top integer, parameter :: REGRIDDING_ADAPTIVE = 9 !< Adaptive coordinate mode identifier @@ -31,7 +29,6 @@ module regrid_consts character(len=*), parameter :: REGRIDDING_ARBITRARY_STRING = "ARB" !< Arbitrary coordinates character(len=*), parameter :: REGRIDDING_HYCOM1_STRING = "HYCOM1" !< Hycom string character(len=*), parameter :: REGRIDDING_HYBGEN_STRING = "HYBGEN" !< Hybgen string -character(len=*), parameter :: REGRIDDING_SLIGHT_STRING = "SLIGHT" !< Hybrid S-rho string character(len=*), parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR_STRING = "SIGMA_SHELF_ZSTAR" !< Hybrid z*/sigma character(len=*), parameter :: REGRIDDING_ADAPTIVE_STRING = "ADAPTIVE" !< Adaptive coordinate string character(len=*), parameter :: DEFAULT_COORDINATE_MODE = REGRIDDING_LAYER_STRING !< Default coordinate mode @@ -63,7 +60,6 @@ function coordinateMode(string) case (trim(REGRIDDING_SIGMA_STRING)); coordinateMode = REGRIDDING_SIGMA case (trim(REGRIDDING_HYCOM1_STRING)); coordinateMode = REGRIDDING_HYCOM1 case (trim(REGRIDDING_HYBGEN_STRING)); coordinateMode = REGRIDDING_HYBGEN - case (trim(REGRIDDING_SLIGHT_STRING)); coordinateMode = REGRIDDING_SLIGHT case (trim(REGRIDDING_ARBITRARY_STRING)); coordinateMode = REGRIDDING_ARBITRARY case (trim(REGRIDDING_SIGMA_SHELF_ZSTAR_STRING)); coordinateMode = REGRIDDING_SIGMA_SHELF_ZSTAR case (trim(REGRIDDING_ADAPTIVE_STRING)); coordinateMode = REGRIDDING_ADAPTIVE @@ -85,7 +81,6 @@ function coordinateUnitsI(coordMode) case (REGRIDDING_SIGMA); coordinateUnitsI = "Non-dimensional" case (REGRIDDING_HYCOM1); coordinateUnitsI = "m" case (REGRIDDING_HYBGEN); coordinateUnitsI = "m" - case (REGRIDDING_SLIGHT); coordinateUnitsI = "m" case (REGRIDDING_ADAPTIVE); coordinateUnitsI = "m" case default ; call MOM_error(FATAL, "coordinateUnts: "//& "Unrecognized coordinate mode.") @@ -121,7 +116,6 @@ logical function state_dependent_int(mode) case (REGRIDDING_SIGMA); state_dependent_int = .false. case (REGRIDDING_HYCOM1); state_dependent_int = .true. case (REGRIDDING_HYBGEN); state_dependent_int = .true. - case (REGRIDDING_SLIGHT); state_dependent_int = .true. case (REGRIDDING_ADAPTIVE); state_dependent_int = .true. case default ; call MOM_error(FATAL, "state_dependent: "//& "Unrecognized choice of coordinate.") diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 99e6c386c6..9152efa9ec 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -73,6 +73,14 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "ZSTAR_RIGID_SURFACE_THRESHOLD") call obsolete_logical(param_file, "HENYEY_IGW_BACKGROUND_NEW") + call obsolete_real(param_file, "SLIGHT_DZ_SURFACE") + call obsolete_int(param_file, "SLIGHT_NZ_SURFACE_FIXED") + call obsolete_real(param_file, "SLIGHT_SURFACE_AVG_DEPTH") + call obsolete_real(param_file, "SLIGHT_NLAY_TO_INTERIOR") + call obsolete_logical(param_file, "SLIGHT_FIX_HALOCLINES") + call obsolete_real(param_file, "HALOCLINE_FILTER_LENGTH") + call obsolete_real(param_file, "HALOCLINE_STRAT_TOL") + ! Test for inconsistent parameter settings. split = .true. ; test_logic = .false. call read_param(param_file,"SPLIT",split) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index cd5682d2d9..ff0eda6325 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -327,10 +327,6 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe call build_rho_column(get_rho_CS(remap_cs%regrid_cs), GV%ke, & GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) - elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then -! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) - call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & ! GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) From a6f813e059c2b07dfb27b1bbd2b9e501d1817fba Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Mar 2023 14:10:14 -0400 Subject: [PATCH 195/213] (*)Fix MOM_calc_grad_Coriolis GLOBAL_INDEXING bug Fixed a bug in MOM_calculate_grad_Coriolis() that was causing the model to hang due to mismatched halo updates when GLOBAL_INDEXING = True. Also added missing callTree (a.k.a. granny tracker) calls at the start and end of the same routine. All answers are bitwise identical in any cases that worked before. --- src/initialization/MOM_shared_initialization.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 2981bb9e94..46d0448699 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -96,11 +96,13 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) intent(out) :: dF_dy !< y-component of grad f [T-1 L-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables + character(len=40) :: mdl = "MOM_calculate_grad_Coriolis" ! This subroutine's name. integer :: i,j real :: f1, f2 ! Average of adjacent Coriolis parameters [T-1 ~> s-1] + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & - (LBOUND(G%CoriolisBu,2) > G%isc-1)) then + (LBOUND(G%CoriolisBu,2) > G%jsc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. dF_dx(:,:) = 0.0 ; dF_dy(:,:) = 0.0 return @@ -115,6 +117,7 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) + call callTree_leave(trim(mdl)//'()') end subroutine MOM_calculate_grad_Coriolis From ac11984fdb14f905e7a0cc70dc93bcc1443c12bf Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 26 Apr 2023 15:22:38 -0400 Subject: [PATCH 196/213] Reversion of MOM_mixed_layer_restrat growth_time Due to some machines reporting a regression in the mixed layer restratification code, this patch reverts the calculation of the growth time in a separate function. Most of the content related to comments and parameter setup have been retained, even if those parameters are no longer used. --- .../lateral/MOM_mixed_layer_restrat.F90 | 89 +++++++++++++++++-- 1 file changed, 81 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index ffdf236152..fe31eb0de3 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -159,6 +159,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] @@ -194,6 +195,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] + real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times + ! pi squared [nondim] logical :: line_is_empty, keep_going, res_upscale integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -205,6 +208,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var covTS(:) = 0.0 !!Functionality not implemented yet; in future, should be passed in tv varS(:) = 0.0 + vonKar_x_pi2 = CS%vonKar * 9.8696 + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & @@ -316,7 +321,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var p0(:) = 0.0 EOSdom(:) = EOS_domain(G%HI, halo=1) - !$OMP parallel default(shared) private(rho_ml,h_vel,u_star,absf,timescale, & + !$OMP parallel default(shared) private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & !$OMP line_is_empty, keep_going,res_scaling_fac, & !$OMP a,IhTot,b,Ihtot_slow,zpb,hAtVel,zpa,dh) & !$OMP firstprivate(uDml,vDml,uDml_slow,vDml_slow) @@ -379,21 +384,40 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do I=is-1,ie u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! momentum mixing rate: pi^2*visc/h_ml^2 h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z - timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + mom_mixrate = vonKar_x_pi2*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + timescale = timescale * CS%ml_restrat_coef + if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z - timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) + + mom_mixrate = vonKar_x_pi2*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + timescale = timescale * CS%ml_restrat_coef2 + if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -447,21 +471,40 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do J=js-1,je ; do i=is,ie u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! momentum mixing rate: pi^2*visc/h_ml^2 h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z - timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + mom_mixrate = vonKar_x_pi2*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + timescale = timescale * CS%ml_restrat_coef + if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z - timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) + + mom_mixrate = vonKar_x_pi2*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + timescale = timescale * CS%ml_restrat_coef2 + if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -608,6 +651,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times + ! pi squared [nondim] + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] @@ -642,6 +688,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 + vonKar_x_pi2 = CS%vonKar * 9.8696 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z @@ -657,7 +704,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) p0(:) = 0.0 EOSdom(:) = EOS_domain(G%HI, halo=1) - !$OMP parallel default(shared) private(Rho0,h_vel,u_star,absf,timescale, & + !$OMP parallel default(shared) private(Rho0,h_vel,u_star,absf,mom_mixrate,timescale, & !$OMP I2htot,z_topx2,hx2,a) & !$OMP firstprivate(uDml,vDml) !$OMP do @@ -689,8 +736,19 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! momentum mixing rate: pi^2*visc/h_ml^2 + mom_mixrate = vonKar_x_pi2*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + + timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & @@ -729,8 +787,19 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) - timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! momentum mixing rate: pi^2*visc/h_ml^2 + mom_mixrate = vonKar_x_pi2*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + + timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & @@ -799,6 +868,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) end subroutine mixedlayer_restrat_BML +! NOTE: This function appears to change answers on some platforms, so it is +! currently unused in the model, but we intend to introduce it in the future. + !> Return the growth timescale for the submesoscale mixed layer eddies in [T ~> s] real function growth_time(u_star, hBL, absf, h_neg, vonKar, Kv_rest, restrat_coef) real, intent(in) :: u_star !< Surface friction velocity [Z T-1 ~> m s-1] @@ -945,6 +1017,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "used in the MLE scheme. This simply multiplies MLD wherever used.",& units="nondim", default=1.0) endif + call get_param(param_file, mdl, "KV_RESTRAT", CS%Kv_restrat, & "A small viscosity that sets a floor on the momentum mixing rate during "//& "restratification. If this is positive, it will prevent some possible "//& From 61baca8eaa02c77a98432445f00ac76db4f706cf Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 6 Jul 2023 15:21:48 -0600 Subject: [PATCH 197/213] Option to taper neutral diffusion This commit adds the option to apply a linear decay in the neutral diffusion fluxes within a transition zone defined by the boundary layer depths of adjacent columns. This option is controlled by a new parameter NDIFF_TAPERING, which is only available when NDIFF_INTERIOR_ONLY=True. By default NDIFF_TAPERING=False and answers are bitwise identical. --- src/tracer/MOM_neutral_diffusion.F90 | 165 ++++++++++++++++++++++++--- 1 file changed, 147 insertions(+), 18 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index d09c3e2870..a49af87a15 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -53,8 +53,16 @@ module MOM_neutral_diffusion !! density [R L2 T-2 ~> Pa] logical :: interior_only !< If true, only applies neutral diffusion in the ocean interior. !! That is, the algorithm will exclude the surface and bottom boundary layers. + logical :: tapering = .false. !< If true, neutral diffusion linearly decays towards zero within a + !! transition zone defined using boundary layer depths. Only available when + !! interior_only=true. logical :: use_unmasked_transport_bug !< If true, use an older form for the accumulation of !! neutral-diffusion transports that were unmasked, as used prior to Jan 2018. + ! Coefficients used to apply tapering from neutral to horizontal direction + real, allocatable, dimension(:) :: coeff_l !< Non-dimensional coefficient in the left column, + !! at cell interfaces + real, allocatable, dimension(:) :: coeff_r !< Non-dimensional coefficient in the right column, + !! at cell interfaces ! Positions of neutral surfaces in both the u, v directions real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point @@ -172,6 +180,12 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, "If true, only applies neutral diffusion in the ocean interior."//& "That is, the algorithm will exclude the surface and bottom"//& "boundary layers.", default=.false.) + if (CS%interior_only) then + call get_param(param_file, mdl, "NDIFF_TAPERING", CS%tapering, & + "If true, neutral diffusion linearly decays to zero within "//& + "a transition zone defined using boundary layer depths. "//& + "Only applicable when NDIFF_INTERIOR_ONLY=True", default=.false.) + endif call get_param(param_file, mdl, "NDIFF_USE_UNMASKED_TRANSPORT_BUG", CS%use_unmasked_transport_bug, & "If true, use an older form for the accumulation of neutral-diffusion "//& "transports that were unmasked, as used prior to Jan 2018. This is not "//& @@ -257,6 +271,11 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, if ( .not. ASSOCIATED(CS%energetic_PBL_CSp) .and. .not. ASSOCIATED(CS%KPP_CSp) ) then call MOM_error(FATAL,"NDIFF_INTERIOR_ONLY is true, but no valid boundary layer scheme was found") endif + + if (CS%tapering) then + allocate(CS%coeff_l(SZK_(GV)+1), source=0.) + allocate(CS%coeff_r(SZK_(GV)+1), source=0.) + endif endif ! Store a rescaling factor for use in diagnostic messages. CS%R_to_kg_m3 = US%R_to_kg_m3 @@ -585,7 +604,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) real, dimension(SZI_(G),SZJB_(G)) :: trans_y_2d ! depth integrated diffusive tracer y-transport diagn real, dimension(SZK_(GV)) :: dTracer ! change in tracer concentration due to ndiffusion ! [H L2 conc ~> m3 conc or kg conc] - + real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [H ~> m or kg m-2] type(tracer_type), pointer :: Tracer => NULL() ! Pointer to the current tracer integer :: i, j, k, m, ks, nk @@ -594,6 +613,14 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff + ! Check if hbl needs to be extracted + if (CS%tapering) then + if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) + if (ASSOCIATED(CS%energetic_PBL_CSp)) call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, & + m_to_MLD_units=GV%m_to_H) + call pass_var(hbl,G%Domain) + endif + if (.not. CS%continuous_reconstruction) then if (CS%remap_answer_date < 20190101) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -619,24 +646,53 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) ! x-flux do j = G%jsc,G%jec ; do I = G%isc-1,G%iec if (G%mask2dCu(I,j)>0.) then - call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & - tracer%t(i,j,:), tracer%t(i+1,j,:), & - CS%uPoL(I,j,:), CS%uPoR(I,j,:), & - CS%uKoL(I,j,:), CS%uKoR(I,j,:), & - CS%uhEff(I,j,:), uFlx(I,j,:), & - CS%continuous_reconstruction, h_neglect, CS%remap_CS, h_neglect_edge) + if (CS%tapering) then + ! compute coeff_l and coeff_r and pass them to neutral_surface_flux + call compute_tapering_coeffs(G%ke+1, hbl(I,j), hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & + h(I,j,:), h(I+1,j,:)) + + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & + tracer%t(i,j,:), tracer%t(i+1,j,:), & + CS%uPoL(I,j,:), CS%uPoR(I,j,:), & + CS%uKoL(I,j,:), CS%uKoR(I,j,:), & + CS%uhEff(I,j,:), uFlx(I,j,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%coeff_l(:), CS%coeff_r(:)) + else + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & + tracer%t(i,j,:), tracer%t(i+1,j,:), & + CS%uPoL(I,j,:), CS%uPoR(I,j,:), & + CS%uKoL(I,j,:), CS%uKoR(I,j,:), & + CS%uhEff(I,j,:), uFlx(I,j,:), & + CS%continuous_reconstruction, h_neglect, CS%remap_CS, h_neglect_edge) + endif endif enddo ; enddo ! y-flux do J = G%jsc-1,G%jec ; do i = G%isc,G%iec if (G%mask2dCv(i,J)>0.) then - call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & - tracer%t(i,j,:), tracer%t(i,j+1,:), & - CS%vPoL(i,J,:), CS%vPoR(i,J,:), & - CS%vKoL(i,J,:), CS%vKoR(i,J,:), & - CS%vhEff(i,J,:), vFlx(i,J,:), & - CS%continuous_reconstruction, h_neglect, CS%remap_CS, h_neglect_edge) + if (CS%tapering) then + ! compute coeff_l and coeff_r and pass them to neutral_surface_flux + call compute_tapering_coeffs(G%ke+1, hbl(i,J), hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & + h(i,J,:), h(i,J+1,:)) + + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & + tracer%t(i,j,:), tracer%t(i,j+1,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), & + CS%vKoL(i,J,:), CS%vKoR(i,J,:), & + CS%vhEff(i,J,:), vFlx(i,J,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%coeff_l(:), CS%coeff_r(:)) + else + + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & + tracer%t(i,j,:), tracer%t(i,j+1,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), & + CS%vKoL(i,J,:), CS%vKoR(i,J,:), & + CS%vhEff(i,J,:), vFlx(i,J,:), & + CS%continuous_reconstruction, h_neglect, CS%remap_CS, h_neglect_edge) + endif endif enddo ; enddo @@ -736,6 +792,62 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) end subroutine neutral_diffusion +!> Computes linear tapering coefficients at interfaces of the left and right columns +!! within a region defined by the boundary layer depths in the two columns. +subroutine compute_tapering_coeffs(ne, bld_l, bld_r, coeff_l, coeff_r, h_l, h_r) + integer, intent(in) :: ne !< Number of interfaces + real, intent(in) :: bld_l !< Boundary layer depth, left column [H ~> m or kg m-2] + real, intent(in) :: bld_r !< Boundary layer depth, right column [H ~> m or kg m-2] + real, dimension(ne-1), intent(in) :: h_l !< Layer thickness, left column [H ~> m or kg m-2] + real, dimension(ne-1), intent(in) :: h_r !< Layer thickness, right column [H ~> m or kg m-2] + real, dimension(ne), intent(inout) :: coeff_l !< Tapering coefficient, left column [nondim] + real, dimension(ne), intent(inout) :: coeff_r !< Tapering coefficient, right column [nondim] + + ! Local variables + real :: min_bld, max_bld ! Min/Max boundary layer depth in two adjacent columns + integer :: dummy1 ! dummy integer + real :: dummy2 ! dummy real + integer :: k_min_l, k_min_r, k_max_l, k_max_r ! Min/max vertical indices in two adjacent columns + real :: zeta_l, zeta_r ! dummy variables + integer :: k ! vertical index + + ! initialize coeffs + coeff_l(:) = 1.0 + coeff_r(:) = 1.0 + + ! Calculate vertical indices containing the boundary layer depths + max_bld = MAX(bld_l, bld_r) + min_bld = MIN(bld_l, bld_r) + + ! k_min + call boundary_k_range(SURFACE, ne-1, h_l, min_bld, dummy1, dummy2, k_min_l, & + zeta_l) + call boundary_k_range(SURFACE, ne-1, h_r, min_bld, dummy1, dummy2, k_min_r, & + zeta_r) + + ! k_max + call boundary_k_range(SURFACE, ne-1, h_l, max_bld, dummy1, dummy2, k_max_l, & + zeta_l) + call boundary_k_range(SURFACE, ne-1, h_r, max_bld, dummy1, dummy2, k_max_r, & + zeta_r) + ! left + do k=1,k_min_l + coeff_l(k) = 0.0 + enddo + do k=k_min_l+1,k_max_l+1 + coeff_l(k) = (real(k - k_min_l) + 1.0)/(real(k_max_l - k_min_l) + 2.0) + enddo + + ! right + do k=1,k_min_r + coeff_r(k) = 0.0 + enddo + do k=k_min_r+1,k_max_r+1 + coeff_r(k) = (real(k - k_min_r) + 1.0)/(real(k_max_r - k_min_r) + 2.0) + enddo + +end subroutine compute_tapering_coeffs + !> Returns interface scalar, Si, for a column of layer values, S. subroutine interface_scalar(nk, h, S, Si, i_method, h_neglect) integer, intent(in) :: nk !< Number of levels @@ -1921,7 +2033,8 @@ end function absolute_positions !> Returns a single column of neutral diffusion fluxes of a tracer. subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, KoR, & - hEff, Flx, continuous, h_neglect, remap_CS, h_neglect_edge) + hEff, Flx, continuous, h_neglect, remap_CS, h_neglect_edge, & + coeff_l, coeff_r) integer, intent(in) :: nk !< Number of levels integer, intent(in) :: nsurf !< Number of neutral surfaces integer, intent(in) :: deg !< Degree of polynomial reconstructions @@ -1945,11 +2058,14 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K !! to create sublayers real, optional, intent(in) :: h_neglect_edge !< A negligibly small width used for !! edge value calculations if continuous is false [H ~> m or kg m-2] + real, dimension(nk+1), optional, intent(in) :: coeff_l !< Left-column diffusivity [L2 T-1 ~> m2 s-1] + real, dimension(nk+1), optional, intent(in) :: coeff_r !< Right-column diffusivity [L2 T-1 ~> m2 s-1] + ! Local variables integer :: k_sublayer, klb, klt, krb, krt real :: T_right_top, T_right_bottom, T_right_layer, T_right_sub, T_right_top_int, T_right_bot_int real :: T_left_top, T_left_bottom, T_left_layer, T_left_sub, T_left_top_int, T_left_bot_int - real :: dT_top, dT_bottom, dT_layer, dT_ave, dT_sublayer, dT_top_int, dT_bot_int + real :: dT_top, dT_bottom, dT_layer, dT_ave, dT_sublayer, dT_top_int, dT_bot_int, khtr_ave real, dimension(nk+1) :: Til !< Left-column interface tracer (conc, e.g. degC) real, dimension(nk+1) :: Tir !< Right-column interface tracer (conc, e.g. degC) real, dimension(nk) :: aL_l !< Left-column left edge value of tracer (conc, e.g. degC) @@ -1964,7 +2080,12 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K real, dimension(nk,deg+1) :: ppoly_r_coeffs_r real, dimension(nk,deg+1) :: ppoly_r_S_l real, dimension(nk,deg+1) :: ppoly_r_S_r - logical :: down_flux + logical :: down_flux, tapering + + tapering = .false. + if (present(coeff_l) .and. present(coeff_r)) tapering = .true. + khtr_ave = 1.0 + ! Setup reconstruction edge values if (continuous) then call interface_scalar(nk, hl, Tl, Til, 2, h_neglect) @@ -1987,6 +2108,14 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K if (hEff(k_sublayer) == 0.) then Flx(k_sublayer) = 0. else + if (tapering) then + klb = KoL(k_sublayer+1) + klt = KoL(k_sublayer) + krb = KoR(k_sublayer+1) + krt = KoR(k_sublayer) + ! these are added in this order to preserve vertically-uniform diffusivity answers + khtr_ave = 0.25 * ((coeff_l(klb) + coeff_l(klt)) + (coeff_r(krb) + coeff_r(krt))) + endif if (continuous) then klb = KoL(k_sublayer+1) T_left_bottom = ( 1. - PiL(k_sublayer+1) ) * Til(klb) + PiL(k_sublayer+1) * Til(klb+1) @@ -2010,7 +2139,7 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K else dT_ave = dT_layer endif - Flx(k_sublayer) = dT_ave * hEff(k_sublayer) + Flx(k_sublayer) = dT_ave * hEff(k_sublayer) * khtr_ave else ! Discontinuous reconstruction ! Calculate tracer values on left and right side of the neutral surface call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, & @@ -2036,7 +2165,7 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K dT_sublayer >= 0. .and. dT_top_int >= 0. .and. & dT_bot_int >= 0.) if (down_flux) then - Flx(k_sublayer) = dT_sublayer * hEff(k_sublayer) + Flx(k_sublayer) = dT_sublayer * hEff(k_sublayer) * khtr_ave else Flx(k_sublayer) = 0. endif From b4bd223222b893097880a30452a4b09996feb1c7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 19 Jul 2023 14:31:06 -0600 Subject: [PATCH 198/213] Output relevant fields when diff or visc < 0 Writes useful fields when the diffusivity of viscosity is less than zero. The should help understanding the root cause of such cases and facilitate the necessary adjustments. --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 0127f8c556..44b1d720b1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -787,6 +787,22 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! safety check, Kviscosity and Kdiffusivity must be >= 0 do k=1, GV%ke+1 if (Kviscosity(k) < 0. .or. Kdiffusivity(k,1) < 0.) then + write(*,'(a,3i3)') 'interface, i, j, k = ',j, j, k + write(*,'(a,2f12.5)') 'lon,lat=', G%geoLonT(i,j), G%geoLatT(i,j) + write(*,'(a,es12.4)') 'depth, z_inter(k) =',z_inter(k) + write(*,'(a,es12.4)') 'Kviscosity(k) =',Kviscosity(k) + write(*,'(a,es12.4)') 'Kdiffusivity(k,1) =',Kdiffusivity(k,1) + write(*,'(a,es12.4)') 'Kdiffusivity(k,2) =',Kdiffusivity(k,2) + write(*,'(a,es12.4)') 'OBLdepth =',US%Z_to_m*CS%OBLdepth(i,j) + write(*,'(a,f8.4)') 'kOBL =',CS%kOBL(i,j) + write(*,'(a,es12.4)') 'u* =',surfFricVel + write(*,'(a,es12.4)') 'bottom, z_inter(GV%ke+1) =',z_inter(GV%ke+1) + write(*,'(a,es12.4)') 'CS%La_SL(i,j) =',CS%La_SL(i,j) + write(*,'(a,es12.4)') 'LangEnhK =',LangEnhK + if (present(lamult)) write(*,'(a,es12.4)') 'lamult(i,j) =',lamult(i,j) + write(*,*) 'Kviscosity(:) =',Kviscosity(:) + write(*,*) 'Kdiffusivity(:,1) =',Kdiffusivity(:,1) + call MOM_error(FATAL,"KPP_calculate, after CVMix_coeffs_kpp: "// & "Negative vertical viscosity or diffusivity has been detected. " // & "This is likely related to the choice of MATCH_TECHNIQUE and INTERP_TYPE2." //& From 8234e696d9d8e82c645a8c09177efca67ee2e087 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jul 2023 11:09:57 -0600 Subject: [PATCH 199/213] Add hbd to the control structure Simplifies and reduces the code by adding hbd to the neutral diffusion contril structure. This avoid the need to "extract" hbl multiple times. Answers are bitwise indenticals. --- src/tracer/MOM_neutral_diffusion.F90 | 23 +++++++---------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 7a5c93d4fa..01c2522145 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -58,6 +58,7 @@ module MOM_neutral_diffusion !! interior_only=true. logical :: use_unmasked_transport_bug !< If true, use an older form for the accumulation of !! neutral-diffusion transports that were unmasked, as used prior to Jan 2018. + real, allocatable, dimension(:,:) :: hbl !< Boundary layer depth [H ~> m or kg m-2] ! Coefficients used to apply tapering from neutral to horizontal direction real, allocatable, dimension(:) :: coeff_l !< Non-dimensional coefficient in the left column, !! at cell interfaces @@ -335,7 +336,6 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Variables used for reconstructions real, dimension(SZK_(GV),2) :: ppoly_r_S ! Reconstruction slopes real, dimension(SZI_(G), SZJ_(G)) :: hEff_sum ! Summed effective face thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [H ~> m or kg m-2] integer :: iMethod real, dimension(SZI_(G)) :: ref_pres ! Reference pressure used to calculate alpha/beta [R L2 T-2 ~> Pa] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] @@ -354,14 +354,14 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Check if hbl needs to be extracted if (CS%interior_only) then - if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) - if (ASSOCIATED(CS%energetic_PBL_CSp)) call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, & + if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, CS%hbl, G, US, m_to_BLD_units=GV%m_to_H) + if (ASSOCIATED(CS%energetic_PBL_CSp)) call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, CS%hbl, G, US, & m_to_MLD_units=GV%m_to_H) - call pass_var(hbl,G%Domain) + call pass_var(CS%hbl,G%Domain) ! get k-indices and zeta do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 if (G%mask2dT(i,j) > 0.0) then - call boundary_k_range(SURFACE, G%ke, h(i,j,:), hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) + call boundary_k_range(SURFACE, G%ke, h(i,j,:), CS%hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) endif enddo; enddo ! TODO: add similar code for BOTTOM boundary layer @@ -604,7 +604,6 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) real, dimension(SZI_(G),SZJB_(G)) :: trans_y_2d ! depth integrated diffusive tracer y-transport diagn real, dimension(SZK_(GV)) :: dTracer ! change in tracer concentration due to ndiffusion ! [H L2 conc ~> m3 conc or kg conc] - real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [H ~> m or kg m-2] type(tracer_type), pointer :: Tracer => NULL() ! Pointer to the current tracer integer :: i, j, k, m, ks, nk @@ -613,14 +612,6 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff - ! Check if hbl needs to be extracted - if (CS%tapering) then - if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) - if (ASSOCIATED(CS%energetic_PBL_CSp)) call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, & - m_to_MLD_units=GV%m_to_H) - call pass_var(hbl,G%Domain) - endif - if (.not. CS%continuous_reconstruction) then if (CS%remap_answer_date < 20190101) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -648,7 +639,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) if (G%mask2dCu(I,j)>0.) then if (CS%tapering) then ! compute coeff_l and coeff_r and pass them to neutral_surface_flux - call compute_tapering_coeffs(G%ke+1, hbl(I,j), hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & + call compute_tapering_coeffs(G%ke+1, CS%hbl(I,j), CS%hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & h(I,j,:), h(I+1,j,:)) call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & @@ -674,7 +665,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) if (G%mask2dCv(i,J)>0.) then if (CS%tapering) then ! compute coeff_l and coeff_r and pass them to neutral_surface_flux - call compute_tapering_coeffs(G%ke+1, hbl(i,J), hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & + call compute_tapering_coeffs(G%ke+1, CS%hbl(i,J), CS%hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & h(i,J,:), h(i,J+1,:)) call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & From 53ccbc329b40156737a2ae15a3c596832ed9b4e1 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jul 2023 11:26:26 -0600 Subject: [PATCH 200/213] Fix line length --- src/tracer/MOM_neutral_diffusion.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 01c2522145..3f3a3fdf10 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -361,7 +361,8 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! get k-indices and zeta do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 if (G%mask2dT(i,j) > 0.0) then - call boundary_k_range(SURFACE, G%ke, h(i,j,:), CS%hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) + call boundary_k_range(SURFACE, G%ke, h(i,j,:), CS%hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), & + zeta_bot(i,j)) endif enddo; enddo ! TODO: add similar code for BOTTOM boundary layer From cf29f1beb2b4a364c596ce09be58074437917136 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jul 2023 11:38:01 -0600 Subject: [PATCH 201/213] Allocate hbl --- src/tracer/MOM_neutral_diffusion.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 3f3a3fdf10..ee2d5e6a03 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -267,6 +267,7 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, endif if (CS%interior_only) then + allocate(CS%hbl(SZI_(G),SZJ_(G)), source=0.) call extract_diabatic_member(diabatic_CSp, KPP_CSp=CS%KPP_CSp) call extract_diabatic_member(diabatic_CSp, energetic_PBL_CSp=CS%energetic_PBL_CSp) if ( .not. ASSOCIATED(CS%energetic_PBL_CSp) .and. .not. ASSOCIATED(CS%KPP_CSp) ) then From 36c1e266b38414b89a759b68952144123d8968dd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 31 Jul 2023 10:39:17 -0600 Subject: [PATCH 202/213] Make tracer diffusivities 3D This commit adds a vertical dimension to the tracer diffusivities (Kh_u and Kh_v) and associated coefficiets (coef_x and coef_y). The following diagnostics were changed from 2D (lat/lon) to 3D (lat/lon/depth): KhTr_u, KhTr_v, and KhTr_h. To preserve old answers, the values of all modified arrays are depth independent by default. The option to apply the equivalent barotropic structure as the vertical structure of the tracer diffusivity is also introduced and this can be controlled via a new parameter: KHTR_USE_EBT_STRUCT (default is false). --- src/tracer/MOM_tracer_hor_diff.F90 | 196 ++++++++++++++++++++--------- 1 file changed, 136 insertions(+), 60 deletions(-) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 79e99f8bb7..6f4e5d0f90 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -52,6 +52,8 @@ module MOM_tracer_hor_diff real :: max_diff_CFL !< If positive, locally limit the along-isopycnal !! tracer diffusivity to keep the diffusive CFL !! locally at or below this value [nondim]. + logical :: KhTh_use_ebt_struct !< If true, uses the equivalent barotropic structure + !! as the vertical structure of tracer diffusivity. logical :: Diffuse_ML_interior !< If true, diffuse along isopycnals between !! the mixed layer and the interior. logical :: check_diffusive_CFL !< If true, automatically iterate the diffusion @@ -135,19 +137,22 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a ! grid cell [H-1 L-2 ~> m-3 or kg-1]. - Kh_h, & ! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of concentration [Conc]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: Kh_h + ! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJ_(G)) :: & - khdt_x, & ! The value of Khtr*dt times the open face width divided by + khdt_x ! The value of Khtr*dt times the open face width divided by ! the distance between adjacent tracer points [L2 ~> m2]. + real, dimension(SZI_(G),SZJB_(G)) :: & + khdt_y ! The value of Khtr*dt times the open face width divided by + ! the distance between adjacent tracer points [L2 ~> m2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & Coef_x, & ! The coefficients relating zonal tracer differences to time-integrated ! fluxes, in [L2 ~> m2] for some schemes and [H L2 ~> m3 or kg] for others. Kh_u ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJB_(G)) :: & - khdt_y, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [L2 ~> m2]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & Coef_y, & ! The coefficients relating meridional tracer differences to time-integrated ! fluxes, in [L2 ~> m2] for some schemes and [H L2 ~> m3 or kg] for others. Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. @@ -224,12 +229,12 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) - Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) + Kh_u(I,j,1) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points - Kh_loc = Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Kh_loc = Kh_u(I,j,1)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max - Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min + Kh_u(I,j,1) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif enddo ; enddo !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) @@ -241,41 +246,41 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) - Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) + Kh_v(i,J,1) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity Rd_dx = 0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points - Kh_loc = Kh_v(i,J)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Kh_loc = Kh_v(i,J,1)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max - Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min + Kh_v(i,J,1) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j,1)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J,1)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) - Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) + Kh_u(I,j,1) = max(CS%KhTr * Res_fn, CS%KhTr_min) khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) - Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) + Kh_v(i,J,1) = max(CS%KhTr * Res_fn, CS%KhTr_min) khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - Kh_u(I,j) = CS%KhTr + Kh_u(I,j,1) = CS%KhTr khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else @@ -287,7 +292,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - Kh_v(i,J) = CS%KhTr + Kh_v(i,J,1) = CS%KhTr khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else @@ -306,7 +311,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Kh_u(I,j,1) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else @@ -323,7 +328,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Kh_v(i,J,1) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else @@ -393,14 +398,36 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) - do J=js-1,je ; do i=is,ie - Coef_y(i,J) = I_numitts * khdt_y(i,J) - enddo ; enddo - do j=js,je - do I=is-1,ie - Coef_x(I,j) = I_numitts * khdt_x(I,j) + do k=1,nz+1 + do J=js-1,je + do i=is,ie + Coef_y(i,J,K) = I_numitts * khdt_y(i,J) + enddo enddo enddo + do k=1,nz+1 + do j=js,je + do I=is-1,ie + Coef_x(I,j,K) = I_numitts * khdt_x(I,j) + enddo + enddo + enddo + if (CS%KhTh_use_ebt_struct) then + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Coef_y(i,J,K) = Coef_y(i,J,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + enddo + enddo + enddo + do k=2,nz+1 + do j=js,je + do I=is-1,ie + Coef_x(I,j,K) = Coef_x(I,j,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + enddo + enddo + enddo + endif do itt=1,num_itts if (CS%show_call_tree) call callTree_waypoint("Calling horizontal boundary diffusion (tracer_hordiff)",itt) @@ -426,14 +453,37 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, CS%neutral_diffusion_CSp) endif - do J=js-1,je ; do i=is,ie - Coef_y(i,J) = I_numitts * khdt_y(i,J) - enddo ; enddo - do j=js,je - do I=is-1,ie - Coef_x(I,j) = I_numitts * khdt_x(I,j) + + do k=1,nz+1 + do J=js-1,je + do i=is,ie + Coef_y(i,J,K) = I_numitts * khdt_y(i,J) + enddo + enddo + enddo + do k=1,nz+1 + do j=js,je + do I=is-1,ie + Coef_x(I,j,K) = I_numitts * khdt_x(I,j) + enddo enddo enddo + if (CS%KhTh_use_ebt_struct) then + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Coef_y(i,J,K) = Coef_y(i,J,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + enddo + enddo + enddo + do k=2,nz+1 + do j=js,je + do I=is-1,ie + Coef_x(I,j,K) = Coef_x(I,j,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + enddo + enddo + enddo + endif do itt=1,num_itts if (CS%show_call_tree) call callTree_waypoint("Calling neutral diffusion (tracer_hordiff)",itt) @@ -467,13 +517,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online endif do J=js-1,je ; do i=is,ie - Coef_y(i,J) = ((scale * khdt_y(i,J))*2.0*(h(i,j,k)*h(i,j+1,k))) / & + Coef_y(i,J,1) = ((scale * khdt_y(i,J))*2.0*(h(i,j,k)*h(i,j+1,k))) / & (h(i,j,k)+h(i,j+1,k)+h_neglect) enddo ; enddo do j=js,je do I=is-1,ie - Coef_x(I,j) = ((scale * khdt_x(I,j))*2.0*(h(i,j,k)*h(i+1,j,k))) / & + Coef_x(I,j,1) = ((scale * khdt_x(I,j))*2.0*(h(i,j,k)*h(i+1,j,k))) / & (h(i,j,k)+h(i+1,j,k)+h_neglect) enddo @@ -485,25 +535,25 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do m=1,ntr do j=js,je ; do i=is,ie dTr(i,j) = Ihdxdy(i,j) * & - ((Coef_x(I-1,j) * (Reg%Tr(m)%t(i-1,j,k) - Reg%Tr(m)%t(i,j,k)) - & - Coef_x(I,j) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))) + & - (Coef_y(i,J-1) * (Reg%Tr(m)%t(i,j-1,k) - Reg%Tr(m)%t(i,j,k)) - & - Coef_y(i,J) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) + ((Coef_x(I-1,j,1) * (Reg%Tr(m)%t(i-1,j,k) - Reg%Tr(m)%t(i,j,k)) - & + Coef_x(I,j,1) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))) + & + (Coef_y(i,J-1,1) * (Reg%Tr(m)%t(i,j-1,k) - Reg%Tr(m)%t(i,j,k)) - & + Coef_y(i,J,1) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) enddo ; enddo if (associated(Reg%Tr(m)%df_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j) & + Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j,1) & * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k)) * Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + Coef_y(i,J) & + Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + Coef_y(i,J,1) & * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)) * Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + Coef_x(I,j) & + Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + Coef_x(I,j,1) & * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k)) * Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + Coef_y(i,J) & + Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + Coef_y(i,J,1) & * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)) * Idt enddo ; enddo ; endif do j=js,je ; do i=is,ie @@ -542,43 +592,65 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online ! post diagnostics for 2d tracer diffusivity if (CS%id_KhTr_u > 0) then do j=js,je ; do I=is-1,ie - Kh_u(I,j) = G%mask2dCu(I,j)*Kh_u(I,j) + Kh_u(I,j,:) = G%mask2dCu(I,j)*Kh_u(I,j,1) enddo ; enddo - call post_data(CS%id_KhTr_u, Kh_u, CS%diag, mask=G%mask2dCu) + if (CS%KhTh_use_ebt_struct) then + do K=2,nz+1 + do j=js,je + do I=is-1,ie + Kh_u(I,j,K) = Kh_u(I,j,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + enddo + enddo + enddo + endif + !call post_data(CS%id_KhTr_u, Kh_u, CS%diag, is_static=.false., mask=G%mask2dCu) + call post_data(CS%id_KhTr_u, Kh_u, CS%diag) endif if (CS%id_KhTr_v > 0) then do J=js-1,je ; do i=is,ie - Kh_v(i,J) = G%mask2dCv(i,J)*Kh_v(i,J) + Kh_v(i,J,:) = G%mask2dCv(i,J)*Kh_v(i,J,1) enddo ; enddo - call post_data(CS%id_KhTr_v, Kh_v, CS%diag, mask=G%mask2dCv) + if (CS%KhTh_use_ebt_struct) then + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Kh_v(i,J,K) = Kh_v(i,J,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + enddo + enddo + enddo + endif + !call post_data(CS%id_KhTr_v, Kh_v, CS%diag, is_static=.false., mask=G%mask2dCv) + call post_data(CS%id_KhTr_v, Kh_v, CS%diag) endif if (CS%id_KhTr_h > 0) then - Kh_h(:,:) = 0.0 + Kh_h(:,:,:) = 0.0 do j=js,je ; do I=is-1,ie - Kh_u(I,j) = G%mask2dCu(I,j)*Kh_u(I,j) + Kh_u(I,j,1) = G%mask2dCu(I,j)*Kh_u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - Kh_v(i,J) = G%mask2dCv(i,J)*Kh_v(i,J) + Kh_v(i,J,1) = G%mask2dCv(i,J)*Kh_v(i,J,1) enddo ; enddo + do j=js,je ; do i=is,ie normalize = 1.0 / ((G%mask2dCu(I-1,j)+G%mask2dCu(I,j)) + & (G%mask2dCv(i,J-1)+G%mask2dCv(i,J)) + 1.0e-37) - Kh_h(i,j) = normalize*G%mask2dT(i,j)*((Kh_u(I-1,j)+Kh_u(I,j)) + & - (Kh_v(i,J-1)+Kh_v(i,J))) + Kh_h(i,j,:) = normalize*G%mask2dT(i,j)*((Kh_u(I-1,j,1)+Kh_u(I,j,1)) + & + (Kh_v(i,J-1,1)+Kh_v(i,J,1))) + if (CS%KhTh_use_ebt_struct) then + do K=2,nz+1 + Kh_h(i,j,K) = normalize*G%mask2dT(i,j)*VarMix%ebt_struct(i,j,k-1)*((Kh_u(I-1,j,1)+Kh_u(I,j,1)) + & + (Kh_v(i,J-1,1)+Kh_v(i,J,1))) + enddo + endif enddo ; enddo - call post_data(CS%id_KhTr_h, Kh_h, CS%diag, mask=G%mask2dT) + !call post_data(CS%id_KhTr_h, Kh_h, CS%diag, is_static=.false., mask=G%mask2dT) + call post_data(CS%id_KhTr_h, Kh_h, CS%diag) endif - if (CS%debug) then call uvchksum("After tracer diffusion khdt_[xy]", khdt_x, khdt_y, & G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2, & scalar_pair=.true.) - if (CS%use_neutral_diffusion) then - call uvchksum("After tracer diffusion Coef_[xy]", Coef_x, Coef_y, & - G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2, & - scalar_pair=.true.) - endif endif if (CS%id_khdt_x > 0) call post_data(CS%id_khdt_x, khdt_x, CS%diag) @@ -1489,6 +1561,10 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic call get_param(param_file, mdl, "KHTR", CS%KhTr, & "The background along-isopycnal tracer diffusivity.", & units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) + call get_param(param_file, mdl, "KHTR_USE_EBT_STRUCT", CS%KhTh_use_ebt_struct, & + "If true, uses the equivalent barotropic structure "//& + "as the vertical structure of the tracer diffusivity.",& + default=.false.) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & "The scaling coefficient for along-isopycnal tracer "//& "diffusivity using a shear-based (Visbeck-like) "//& @@ -1558,11 +1634,11 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic CS%id_KhTr_h = -1 CS%id_CFL = -1 - CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & + CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCui, Time, & 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & + CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCvi, Time, & 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & + CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesTi, Time, & 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrelo', & cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & From a588033727ea2e366d3893fe7670b1cda16cb03e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 31 Jul 2023 10:53:07 -0600 Subject: [PATCH 203/213] Make HBD work with 3D diffusivities Following up on the previous commit, where a vertical dimension was added to the tracer diffusivities, this commit modifies the HBD module to work with this change. To do so, parameter khtr_u (diffusivity times the time step) is calculated at cell centers and then remapped onto the HBD vertical grid. All unit tests in this module were updated to conform with this change. This commit also makes the default value of HBD_DEBUG equal to the value set for DEBUG. --- src/tracer/MOM_hor_bnd_diffusion.F90 | 81 ++++++++++++++++------------ 1 file changed, 47 insertions(+), 34 deletions(-) diff --git a/src/tracer/MOM_hor_bnd_diffusion.F90 b/src/tracer/MOM_hor_bnd_diffusion.F90 index b89552e8e4..4f6f198ff8 100644 --- a/src/tracer/MOM_hor_bnd_diffusion.F90 +++ b/src/tracer/MOM_hor_bnd_diffusion.F90 @@ -88,6 +88,7 @@ logical function hor_bnd_diffusion_init(Time, G, GV, US, param_file, diag, diaba ! local variables character(len=80) :: string ! Temporary strings logical :: boundary_extrap ! controls if boundary extrapolation is used in the HBD code + logical :: debug !< If true, write verbose checksums for debugging purposes if (ASSOCIATED(CS)) then call MOM_error(FATAL, "hor_bnd_diffusion_init called with associated control structure.") @@ -145,9 +146,10 @@ logical function hor_bnd_diffusion_init(Time, G, GV, US, param_file, diag, diaba call initialize_remapping( CS%remap_CS, string, boundary_extrapolation = boundary_extrap ,& check_reconstruction=.false., check_remapping=.false.) call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg) + call get_param(param_file, mdl, "DEBUG", debug, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "HBD_DEBUG", CS%debug, & "If true, write out verbose debugging data in the HBD module.", & - default=.false.) + default=debug) id_clock_hbd = cpu_clock_id('(Ocean HBD)', grain=CLOCK_MODULE) @@ -160,17 +162,16 @@ end function hor_bnd_diffusion_init !! 3) remap fluxes to the native grid !! 4) update tracer by adding the divergence of F subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) - type(ocean_grid_type), intent(inout) :: G !< Grid type - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] - real, intent(in) :: dt !< Tracer time step * I_numitts - !! (I_numitts in tracer_hordiff) [T ~> s] - type(tracer_registry_type), pointer :: Reg !< Tracer registry - type(hbd_CS), pointer :: CS !< Control structure for this module + type(ocean_grid_type), intent(inout) :: G !< Grid type + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] + real, intent(in) :: dt !< Tracer time step * I_numitts + !! (I_numitts in tracer_hordiff) [T ~> s] + type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(hbd_CS), pointer :: CS !< Control structure for this module ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: hbl !< Boundary layer depth [H ~> m or kg m-2] @@ -224,9 +225,9 @@ subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) do j=G%jsc,G%jec do i=G%isc-1,G%iec if (G%mask2dCu(I,j)>0.) then - call fluxes_layer_method(SURFACE, G%ke, hbl(I,j), hbl(I+1,j), & + call fluxes_layer_method(SURFACE, GV%ke, hbl(I,j), hbl(I+1,j), & h(I,j,:), h(I+1,j,:), tracer%t(I,j,:), tracer%t(I+1,j,:), & - Coef_x(I,j), uFlx(I,j,:), G%areaT(I,j), G%areaT(I+1,j), CS%hbd_u_kmax(I,j), & + Coef_x(I,j,:), uFlx(I,j,:), G%areaT(I,j), G%areaT(I+1,j), CS%hbd_u_kmax(I,j), & CS%hbd_grd_u(I,j,:), CS) endif enddo @@ -236,7 +237,7 @@ subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) if (G%mask2dCv(i,J)>0.) then call fluxes_layer_method(SURFACE, GV%ke, hbl(i,J), hbl(i,J+1), & h(i,J,:), h(i,J+1,:), tracer%t(i,J,:), tracer%t(i,J+1,:), & - Coef_y(i,J), vFlx(i,J,:), G%areaT(i,J), G%areaT(i,J+1), CS%hbd_v_kmax(i,J), & + Coef_y(i,J,:), vFlx(i,J,:), G%areaT(i,J), G%areaT(i,J+1), CS%hbd_v_kmax(i,J), & CS%hbd_grd_v(i,J,:), CS) endif enddo @@ -667,8 +668,8 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ real, dimension(ke), intent(in ) :: h_R !< Thicknesses in the native grid (right) [H ~> m or kg m-2] real, dimension(ke), intent(in ) :: phi_L !< Tracer values in the native grid (left) [conc] real, dimension(ke), intent(in ) :: phi_R !< Tracer values in the native grid (right) [conc] - real, intent(in ) :: khtr_u !< Horizontal diffusivities times the time step - !! at a velocity point [L2 ~> m2] + real, dimension(ke+1),intent(in ) :: khtr_u !< Horizontal diffusivities times the time step + !! at a velocity point and vertical interfaces [L2 ~> m2] real, dimension(ke), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point !! in the native grid [H L2 conc ~> m3 conc] real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] @@ -681,10 +682,12 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ real, allocatable :: phi_L_z(:) !< Tracer values in the ztop grid (left) [conc] real, allocatable :: phi_R_z(:) !< Tracer values in the ztop grid (right) [conc] real, allocatable :: F_layer_z(:) !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] - real :: h_vel(ke) !< Thicknesses at u- and v-points in the native grid + real, allocatable :: khtr_ul_z(:) !< khtr_u at layer centers in the ztop grid [H L2 conc ~> m3 conc] + real, dimension(ke) :: h_vel !< Thicknesses at u- and v-points in the native grid !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] + real, dimension(ke) :: khtr_ul !< khtr_u at the vertical layer of the native grid [L2 ~> m2] real :: htot !< Total column thickness [H ~> m or kg m-2] - integer :: k + integer :: k !< Index used in the vertical direction integer :: k_bot_min !< Minimum k-index for the bottom integer :: k_bot_max !< Maximum k-index for the bottom integer :: k_bot_diff !< Difference between bottom left and right k-indices @@ -695,11 +698,12 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ real :: zeta_bot_L, zeta_bot_R !< distance from the bottom of a layer to the boundary !! layer depth in the native grid [nondim] real :: wgt !< weight to be used in the linear transition to the interior [nondim] - real :: a !< coefficient to be used in the linear transition to the interior [nondim] + real :: a !< coefficient used in the linear transition to the interior [nondim] real :: tmp1, tmp2 !< dummy variables [H ~> m or kg m-2] real :: htot_max !< depth below which no fluxes should be applied [H ~> m or kg m-2] F_layer(:) = 0.0 + khtr_ul(:) = 0.0 if (hbl_L == 0. .or. hbl_R == 0.) then return endif @@ -708,6 +712,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ allocate(phi_L_z(nk), source=0.0) allocate(phi_R_z(nk), source=0.0) allocate(F_layer_z(nk), source=0.0) + allocate(khtr_ul_z(nk), source=0.0) ! remap tracer to dz_top call remapping_core_h(CS%remap_cs, ke, h_L(:), phi_L(:), nk, dz_top(:), phi_L_z(:), & @@ -715,6 +720,18 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ call remapping_core_h(CS%remap_cs, ke, h_R(:), phi_R(:), nk, dz_top(:), phi_R_z(:), & CS%H_subroundoff, CS%H_subroundoff) + ! thicknesses at velocity points & khtr_u at layer centers + do k = 1,ke + h_vel(k) = harmonic_mean(h_L(k), h_R(k)) + ! GMM, writting 0.5 * (A(k) + A(k+1)) as A(k) + 0.5 * (A(k+1) - A(k)) to recover + ! answers with depth-independent khtr + khtr_ul(k) = khtr_u(k) + 0.5 * (khtr_u(k+1) - khtr_u(k)) + enddo + + ! remap khtr_ul to khtr_ul_z + call remapping_core_h(CS%remap_cs, ke, h_vel(:), khtr_ul(:), nk, dz_top(:), khtr_ul_z(:), & + CS%H_subroundoff, CS%H_subroundoff) + ! Calculate vertical indices containing the boundary layer in dz_top call boundary_k_range(boundary, nk, dz_top, hbl_L, k_top_L, zeta_top_L, k_bot_L, zeta_bot_L) call boundary_k_range(boundary, nk, dz_top, hbl_R, k_top_R, zeta_top_R, k_bot_R, zeta_bot_R) @@ -728,7 +745,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ if ((CS%linear) .and. (k_bot_diff > 1)) then ! apply linear decay at the base of hbl do k = k_bot_min,1,-1 - F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) + F_layer_z(k) = -(dz_top(k) * khtr_ul_z(k)) * (phi_R_z(k) - phi_L_z(k)) if (CS%limiter_remap) call flux_limiter(F_layer_z(k), area_L, area_R, phi_L_z(k), & phi_R_z(k), dz_top(k), dz_top(k)) enddo @@ -741,14 +758,14 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ htot = 0. do k = k_bot_min+1,k_bot_max, 1 wgt = (a*(htot + (dz_top(k) * 0.5))) + 1.0 - F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) * wgt + F_layer_z(k) = -(dz_top(k) * khtr_ul_z(k)) * (phi_R_z(k) - phi_L_z(k)) * wgt htot = htot + dz_top(k) if (CS%limiter_remap) call flux_limiter(F_layer_z(k), area_L, area_R, phi_L_z(k), & phi_R_z(k), dz_top(k), dz_top(k)) enddo else do k = k_bot_min,1,-1 - F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) + F_layer_z(k) = -(dz_top(k) * khtr_ul_z(k)) * (phi_R_z(k) - phi_L_z(k)) if (CS%limiter_remap) call flux_limiter(F_layer_z(k), area_L, area_R, phi_L_z(k), & phi_R_z(k), dz_top(k), dz_top(k)) enddo @@ -757,11 +774,6 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ !GMM, TODO: boundary == BOTTOM - ! thicknesses at velocity points - do k = 1,ke - h_vel(k) = harmonic_mean(h_L(k), h_R(k)) - enddo - ! remap flux to h_vel (native grid) call reintegrate_column(nk, dz_top(:), F_layer_z(:), ke, h_vel(:), F_layer(:)) @@ -792,6 +804,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ deallocate(phi_L_z) deallocate(phi_R_z) deallocate(F_layer_z) + deallocate(khtr_ul_z) end subroutine fluxes_layer_method @@ -805,7 +818,7 @@ logical function near_boundary_unit_tests( verbose ) real, dimension(:), allocatable :: h1 ! Upates layer thicknesses [m] real, dimension(nk) :: phi_L, phi_R ! Tracer values (left and right column) [conc] real, dimension(nk) :: h_L, h_R ! Layer thickness (left and right) [m] - real :: khtr_u ! Horizontal diffusivities at U-point [m2 s-1] + real, dimension(nk+1) :: khtr_u ! Horizontal diffusivities at U-point and interfaces[m2 s-1] real :: hbl_L, hbl_R ! Depth of the boundary layer (left and right) [m] real, dimension(nk) :: F_layer ! Diffusive flux within each layer at U-point [conc m3 s-1] character(len=120) :: test_name ! Title of the unit test @@ -983,7 +996,7 @@ logical function near_boundary_unit_tests( verbose ) hbl_L = 2.; hbl_R = 2. h_L = (/2.,2./) ; h_R = (/2.,2./) phi_L = (/0.,0./) ; phi_R = (/1.,1./) - khtr_u = 1. + khtr_u = (/1.,1.,1./) call hbd_grid_test(SURFACE, hbl_L, hbl_R, h_L, h_R, CS) call fluxes_layer_method(SURFACE, nk, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & khtr_u, F_layer, 1., 1., CS%hbd_u_kmax(1,1), CS%hbd_grd_u(1,1,:), CS) @@ -994,7 +1007,7 @@ logical function near_boundary_unit_tests( verbose ) hbl_L = 2.; hbl_R = 2. h_L = (/2.,2./) ; h_R = (/2.,2./) phi_L = (/2.,1./) ; phi_R = (/1.,1./) - khtr_u = 0.5 + khtr_u = (/0.5,0.5,0.5/) call hbd_grid_test(SURFACE, hbl_L, hbl_R, h_L, h_R, CS) call fluxes_layer_method(SURFACE, nk, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & khtr_u, F_layer, 1., 1., CS%hbd_u_kmax(1,1), CS%hbd_grd_u(1,1,:), CS) @@ -1005,7 +1018,7 @@ logical function near_boundary_unit_tests( verbose ) hbl_L = 2; hbl_R = 2 h_L = (/1.,2./) ; h_R = (/1.,2./) phi_L = (/0.,0./) ; phi_R = (/0.5,2./) - khtr_u = 2. + khtr_u = (/2.,2.,2./) call hbd_grid_test(SURFACE, hbl_L, hbl_R, h_L, h_R, CS) call fluxes_layer_method(SURFACE, nk, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & khtr_u, F_layer, 1., 1., CS%hbd_u_kmax(1,1), CS%hbd_grd_u(1,1,:), CS) @@ -1016,7 +1029,7 @@ logical function near_boundary_unit_tests( verbose ) hbl_L = 12; hbl_R = 20 h_L = (/6.,6./) ; h_R = (/10.,10./) phi_L = (/1.,1./) ; phi_R = (/1.,1./) - khtr_u = 1. + khtr_u = (/1.,1.,1./) call hbd_grid_test(SURFACE, hbl_L, hbl_R, h_L, h_R, CS) call fluxes_layer_method(SURFACE, nk, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & khtr_u, F_layer, 1., 1., CS%hbd_u_kmax(1,1), CS%hbd_grd_u(1,1,:), CS) @@ -1028,7 +1041,7 @@ logical function near_boundary_unit_tests( verbose ) hbl_L = 15; hbl_R = 10. h_L = (/10.,5./) ; h_R = (/10.,0./) phi_L = (/1.,1./) ; phi_R = (/0.,0./) - khtr_u = 1. + khtr_u = (/1.,1.,1./) call hbd_grid_test(SURFACE, hbl_L, hbl_R, h_L, h_R, CS) call fluxes_layer_method(SURFACE, nk, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & khtr_u, F_layer, 1., 1., CS%hbd_u_kmax(1,1), CS%hbd_grd_u(1,1,:), CS) From 27518f750f83697c97b4caee718314856cae259f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 31 Jul 2023 11:17:34 -0600 Subject: [PATCH 204/213] Make neutral diffusion work with 3D diffusivities This commit modifies the neutral diffusion module to work with 3D diffusivities. When the diffusivities are depth dependent (KHTR_USE_EBT_STRUCT=True), a new array (Coef_h, with values at tracer points and at vertical interfaces) with a four-point average between Coef_x and Coef_y is introduced. This array is then used to calculate zonal and meridional neutral fluxes via optional arguments and using an existing four-point average (vertical interfaces of two tracer cells) inside subroutine neutral_surface_flux. The same approach is already used when tapering the neutral diffusive fluxes. In this case, however, the unit of the output from neutral_surface_flux (Flx) is modified because the flux of the tracer between pairs of neutral layers is multiplied by the average of Coef_h. To avoid double counting Coef_h, the code block for updating the tracer concentration from divergence of neutral diffusive flux components also had to be modified for when KHTR_USE_EBT_STRUCT=True. Similar for diagnostics trans_x_2d and trans_y_2d. This commit also makes the default value of NDIFF_DEBUG equal to the value set for DEBUG. --- src/tracer/MOM_neutral_diffusion.F90 | 370 +++++++++++++++++++-------- 1 file changed, 261 insertions(+), 109 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index ee2d5e6a03..3b777c1453 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -56,6 +56,8 @@ module MOM_neutral_diffusion logical :: tapering = .false. !< If true, neutral diffusion linearly decays towards zero within a !! transition zone defined using boundary layer depths. Only available when !! interior_only=true. + logical :: KhTh_use_ebt_struct !< If true, uses the equivalent barotropic structure + !! as the vertical structure of tracer diffusivity. logical :: use_unmasked_transport_bug !< If true, use an older form for the accumulation of !! neutral-diffusion transports that were unmasked, as used prior to Jan 2018. real, allocatable, dimension(:,:) :: hbl !< Boundary layer depth [H ~> m or kg m-2] @@ -64,6 +66,8 @@ module MOM_neutral_diffusion !! at cell interfaces real, allocatable, dimension(:) :: coeff_r !< Non-dimensional coefficient in the right column, !! at cell interfaces + ! Array used when KhTh_use_ebt_struct is true + real, allocatable, dimension(:,:,:) :: Coef_h !< Coef_x and Coef_y averaged at t-points [L2 ~> m2] ! Positions of neutral surfaces in both the u, v directions real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point [nondim] real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point [nondim] @@ -136,13 +140,15 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables - character(len=80) :: string ! Temporary strings + character(len=80) :: string ! Temporary strings integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. - logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that - ! recover the answers for remapping from the end of 2018. - ! Otherwise, use more robust forms of the same expressions. - logical :: boundary_extrap + logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the answers for remapping from the end of 2018. + ! Otherwise, use more robust forms of the same expressions. + logical :: debug ! If true, write verbose checksums for debugging purposes. + logical :: boundary_extrap ! Indicate whether high-order boundary + !! extrapolation should be used within boundary cells. if (associated(CS)) then call MOM_error(FATAL, "neutral_diffusion_init called with associated control structure.") @@ -187,6 +193,10 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, "a transition zone defined using boundary layer depths. "//& "Only applicable when NDIFF_INTERIOR_ONLY=True", default=.false.) endif + call get_param(param_file, mdl, "KHTR_USE_EBT_STRUCT", CS%KhTh_use_ebt_struct, & + "If true, uses the equivalent barotropic structure "//& + "as the vertical structure of the tracer diffusivity.",& + default=.false.,do_not_log=.true.) call get_param(param_file, mdl, "NDIFF_USE_UNMASKED_TRANSPORT_BUG", CS%use_unmasked_transport_bug, & "If true, use an older form for the accumulation of neutral-diffusion "//& "transports that were unmasked, as used prior to Jan 2018. This is not "//& @@ -257,10 +267,10 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, "exiting the iterative loop to find the neutral surface", & default=10) endif + call get_param(param_file, mdl, "DEBUG", debug, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "NDIFF_DEBUG", CS%debug, & "Turns on verbose output for discontinuous neutral "//& - "diffusion routines.", & - default=.false.) + "diffusion routines.", default=debug) call get_param(param_file, mdl, "HARD_FAIL_HEFF", CS%hard_fail_heff, & "Bring down the model if a problem with heff is detected",& default=.true.) @@ -275,10 +285,14 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, endif if (CS%tapering) then - allocate(CS%coeff_l(SZK_(GV)+1), source=0.) - allocate(CS%coeff_r(SZK_(GV)+1), source=0.) + allocate(CS%coeff_l(SZK_(GV)+1), source=1.) + allocate(CS%coeff_r(SZK_(GV)+1), source=1.) endif endif + + if (CS%KhTh_use_ebt_struct) & + allocate(CS%Coef_h(G%isd:G%ied,G%jsd:G%jed,SZK_(GV)+1), source=0.) + ! Store a rescaling factor for use in diagnostic messages. CS%R_to_kg_m3 = US%R_to_kg_m3 @@ -583,16 +597,16 @@ end subroutine neutral_diffusion_calc_coeffs !> Update tracer concentration due to neutral diffusion; layer thickness unchanged by this update. subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] - real, intent(in) :: dt !< Tracer time step * I_numitts [T ~> s] + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] + real, intent(in) :: dt !< Tracer time step * I_numitts [T ~> s] !! (I_numitts in tracer_hordiff) - type(tracer_registry_type), pointer :: Reg !< Tracer registry - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure + type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables real, dimension(SZIB_(G),SZJ_(G),CS%nsurf-1) :: uFlx ! Zonal flux of tracer [H conc ~> m conc or conc kg m-2] @@ -606,12 +620,13 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) real, dimension(SZI_(G),SZJB_(G)) :: trans_y_2d ! depth integrated diffusive tracer y-transport diagn real, dimension(SZK_(GV)) :: dTracer ! change in tracer concentration due to ndiffusion ! [H L2 conc ~> m3 conc or kg conc] + real :: normalize ! normalization used for averaging Coef_x and Coef_y to t-points. + type(tracer_type), pointer :: Tracer => NULL() ! Pointer to the current tracer integer :: i, j, k, m, ks, nk real :: Idt ! The inverse of the time step [T-1 ~> s-1] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] - h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff if (.not. CS%continuous_reconstruction) then @@ -620,6 +635,22 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) endif endif + if (CS%KhTh_use_ebt_struct) then + ! Compute Coef at h points + CS%Coef_h(:,:,:) = 0. + do j = G%jsc,G%jec ; do i = G%isc,G%iec + if (G%mask2dT(i,j)>0.) then + normalize = 1.0 / ((G%mask2dCu(I-1,j)+G%mask2dCu(I,j)) + & + (G%mask2dCv(i,J-1)+G%mask2dCv(i,J)) + 1.0e-37) + do k = 1, GV%ke+1 + CS%Coef_h(i,j,k) = normalize*G%mask2dT(i,j)*((Coef_x(I-1,j,k)+Coef_x(I,j,k)) + & + (Coef_y(i,J-1,k)+Coef_y(i,J,k))) + enddo + endif + enddo; enddo + call pass_var(CS%Coef_h,G%Domain) + endif + nk = GV%ke do m = 1,Reg%ntr ! Loop over tracer registry @@ -637,87 +668,179 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) vFlx(:,:,:) = 0. ! x-flux - do j = G%jsc,G%jec ; do I = G%isc-1,G%iec - if (G%mask2dCu(I,j)>0.) then - if (CS%tapering) then - ! compute coeff_l and coeff_r and pass them to neutral_surface_flux - call compute_tapering_coeffs(G%ke+1, CS%hbl(I,j), CS%hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & - h(I,j,:), h(I+1,j,:)) - - call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & - tracer%t(i,j,:), tracer%t(i+1,j,:), & - CS%uPoL(I,j,:), CS%uPoR(I,j,:), & - CS%uKoL(I,j,:), CS%uKoR(I,j,:), & - CS%uhEff(I,j,:), uFlx(I,j,:), & - CS%continuous_reconstruction, h_neglect, & - CS%remap_CS, h_neglect_edge, CS%coeff_l(:), CS%coeff_r(:)) - else - call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & - tracer%t(i,j,:), tracer%t(i+1,j,:), & - CS%uPoL(I,j,:), CS%uPoR(I,j,:), & - CS%uKoL(I,j,:), CS%uKoR(I,j,:), & - CS%uhEff(I,j,:), uFlx(I,j,:), & - CS%continuous_reconstruction, h_neglect, CS%remap_CS, h_neglect_edge) + if (CS%KhTh_use_ebt_struct) then + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + if (G%mask2dCu(I,j)>0.) then + if (CS%tapering) then + ! compute coeff_l and coeff_r and pass them to neutral_surface_flux + call compute_tapering_coeffs(G%ke+1, CS%hbl(I,j), CS%hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & + h(I,j,:), h(I+1,j,:)) + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & + tracer%t(i,j,:), tracer%t(i+1,j,:), & + CS%uPoL(I,j,:), CS%uPoR(I,j,:), & + CS%uKoL(I,j,:), CS%uKoR(I,j,:), & + CS%uhEff(I,j,:), uFlx(I,j,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%coeff_l(:)*CS%Coef_h(i,j,:), & + CS%coeff_r(:)*CS%Coef_h(i+1,j,:)) + else + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & + tracer%t(i,j,:), tracer%t(i+1,j,:), & + CS%uPoL(I,j,:), CS%uPoR(I,j,:), & + CS%uKoL(I,j,:), CS%uKoR(I,j,:), & + CS%uhEff(I,j,:), uFlx(I,j,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%Coef_h(i,j,:), & + CS%Coef_h(i+1,j,:)) + endif endif - endif - enddo ; enddo + enddo ; enddo + else + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + if (G%mask2dCu(I,j)>0.) then + if (CS%tapering) then + ! compute coeff_l and coeff_r and pass them to neutral_surface_flux + call compute_tapering_coeffs(G%ke+1, CS%hbl(I,j), CS%hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & + h(I,j,:), h(I+1,j,:)) + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & + tracer%t(i,j,:), tracer%t(i+1,j,:), & + CS%uPoL(I,j,:), CS%uPoR(I,j,:), & + CS%uKoL(I,j,:), CS%uKoR(I,j,:), & + CS%uhEff(I,j,:), uFlx(I,j,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%coeff_l(:), & + CS%coeff_r(:)) + else + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & + tracer%t(i,j,:), tracer%t(i+1,j,:), & + CS%uPoL(I,j,:), CS%uPoR(I,j,:), & + CS%uKoL(I,j,:), CS%uKoR(I,j,:), & + CS%uhEff(I,j,:), uFlx(I,j,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge) + endif + endif + enddo ; enddo + endif ! y-flux - do J = G%jsc-1,G%jec ; do i = G%isc,G%iec - if (G%mask2dCv(i,J)>0.) then - if (CS%tapering) then - ! compute coeff_l and coeff_r and pass them to neutral_surface_flux - call compute_tapering_coeffs(G%ke+1, CS%hbl(i,J), CS%hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & - h(i,J,:), h(i,J+1,:)) - - call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & - tracer%t(i,j,:), tracer%t(i,j+1,:), & - CS%vPoL(i,J,:), CS%vPoR(i,J,:), & - CS%vKoL(i,J,:), CS%vKoR(i,J,:), & - CS%vhEff(i,J,:), vFlx(i,J,:), & - CS%continuous_reconstruction, h_neglect, & - CS%remap_CS, h_neglect_edge, CS%coeff_l(:), CS%coeff_r(:)) - else + if (CS%KhTh_use_ebt_struct) then + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + if (G%mask2dCv(i,J)>0.) then + if (CS%tapering) then + ! compute coeff_l and coeff_r and pass them to neutral_surface_flux + call compute_tapering_coeffs(G%ke+1, CS%hbl(i,J), CS%hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & + h(i,J,:), h(i,J+1,:)) + + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & + tracer%t(i,j,:), tracer%t(i,j+1,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), & + CS%vKoL(i,J,:), CS%vKoR(i,J,:), & + CS%vhEff(i,J,:), vFlx(i,J,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%coeff_l(:)*CS%Coef_h(i,j,:), & + CS%coeff_r(:)*CS%Coef_h(i,j+1,:)) + else - call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & - tracer%t(i,j,:), tracer%t(i,j+1,:), & - CS%vPoL(i,J,:), CS%vPoR(i,J,:), & - CS%vKoL(i,J,:), CS%vKoR(i,J,:), & - CS%vhEff(i,J,:), vFlx(i,J,:), & - CS%continuous_reconstruction, h_neglect, CS%remap_CS, h_neglect_edge) + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & + tracer%t(i,j,:), tracer%t(i,j+1,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), & + CS%vKoL(i,J,:), CS%vKoR(i,J,:), & + CS%vhEff(i,J,:), vFlx(i,J,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%Coef_h(i,j,:), & + CS%Coef_h(i,j+1,:)) + endif endif - endif - enddo ; enddo + enddo ; enddo + else + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + if (G%mask2dCv(i,J)>0.) then + if (CS%tapering) then + ! compute coeff_l and coeff_r and pass them to neutral_surface_flux + call compute_tapering_coeffs(G%ke+1, CS%hbl(i,J), CS%hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & + h(i,J,:), h(i,J+1,:)) + + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & + tracer%t(i,j,:), tracer%t(i,j+1,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), & + CS%vKoL(i,J,:), CS%vKoR(i,J,:), & + CS%vhEff(i,J,:), vFlx(i,J,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge, CS%coeff_l(:), & + CS%coeff_r(:)) + else + + call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & + tracer%t(i,j,:), tracer%t(i,j+1,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), & + CS%vKoL(i,J,:), CS%vKoR(i,J,:), & + CS%vhEff(i,J,:), vFlx(i,J,:), & + CS%continuous_reconstruction, h_neglect, & + CS%remap_CS, h_neglect_edge) + endif + endif + enddo ; enddo + endif ! Update the tracer concentration from divergence of neutral diffusive flux components - do j = G%jsc,G%jec ; do i = G%isc,G%iec - if (G%mask2dT(i,j)>0.) then + if (CS%KhTh_use_ebt_struct) then + do j = G%jsc,G%jec ; do i = G%isc,G%iec + if (G%mask2dT(i,j)>0.) then + dTracer(:) = 0. + do ks = 1,CS%nsurf-1 + k = CS%uKoL(I,j,ks) + dTracer(k) = dTracer(k) + uFlx(I,j,ks) + k = CS%uKoR(I-1,j,ks) + dTracer(k) = dTracer(k) - uFlx(I-1,j,ks) + k = CS%vKoL(i,J,ks) + dTracer(k) = dTracer(k) + vFlx(i,J,ks) + k = CS%vKoR(i,J-1,ks) + dTracer(k) = dTracer(k) - vFlx(i,J-1,ks) + enddo + do k = 1, GV%ke + tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & + ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 + enddo - dTracer(:) = 0. - do ks = 1,CS%nsurf-1 - k = CS%uKoL(I,j,ks) - dTracer(k) = dTracer(k) + Coef_x(I,j) * uFlx(I,j,ks) - k = CS%uKoR(I-1,j,ks) - dTracer(k) = dTracer(k) - Coef_x(I-1,j) * uFlx(I-1,j,ks) - k = CS%vKoL(i,J,ks) - dTracer(k) = dTracer(k) + Coef_y(i,J) * vFlx(i,J,ks) - k = CS%vKoR(i,J-1,ks) - dTracer(k) = dTracer(k) - Coef_y(i,J-1) * vFlx(i,J-1,ks) - enddo - do k = 1, GV%ke - tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & - ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) - if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 - enddo + if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then + do k = 1, GV%ke + tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt + enddo + endif - if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then + endif + enddo ; enddo + else + do j = G%jsc,G%jec ; do i = G%isc,G%iec + if (G%mask2dT(i,j)>0.) then + dTracer(:) = 0. + do ks = 1,CS%nsurf-1 + k = CS%uKoL(I,j,ks) + dTracer(k) = dTracer(k) + Coef_x(I,j,1) * uFlx(I,j,ks) + k = CS%uKoR(I-1,j,ks) + dTracer(k) = dTracer(k) - Coef_x(I-1,j,1) * uFlx(I-1,j,ks) + k = CS%vKoL(i,J,ks) + dTracer(k) = dTracer(k) + Coef_y(i,J,1) * vFlx(i,J,ks) + k = CS%vKoR(i,J-1,ks) + dTracer(k) = dTracer(k) - Coef_y(i,J-1,1) * vFlx(i,J-1,ks) + enddo do k = 1, GV%ke - tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt + tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & + ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 enddo - endif - endif - enddo ; enddo + if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then + do k = 1, GV%ke + tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt + enddo + endif + + endif + enddo ; enddo + endif ! Do user controlled underflow of the tracer concentrations. if (tracer%conc_underflow > 0.0) then @@ -729,30 +852,58 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) ! Diagnose vertically summed zonal flux, giving zonal tracer transport from ndiff. ! Note sign corresponds to downgradient flux convention. if (tracer%id_dfx_2d > 0) then - do j = G%jsc,G%jec ; do I = G%isc-1,G%iec - trans_x_2d(I,j) = 0. - if (G%mask2dCu(I,j)>0.) then - do ks = 1,CS%nsurf-1 - trans_x_2d(I,j) = trans_x_2d(I,j) - Coef_x(I,j) * uFlx(I,j,ks) - enddo - trans_x_2d(I,j) = trans_x_2d(I,j) * Idt - endif - enddo ; enddo + + if (CS%KhTh_use_ebt_struct) then + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + trans_x_2d(I,j) = 0. + if (G%mask2dCu(I,j)>0.) then + do ks = 1,CS%nsurf-1 + trans_x_2d(I,j) = trans_x_2d(I,j) - uFlx(I,j,ks) + enddo + trans_x_2d(I,j) = trans_x_2d(I,j) * Idt + endif + enddo ; enddo + else + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + trans_x_2d(I,j) = 0. + if (G%mask2dCu(I,j)>0.) then + do ks = 1,CS%nsurf-1 + trans_x_2d(I,j) = trans_x_2d(I,j) - Coef_x(I,j,1) * uFlx(I,j,ks) + enddo + trans_x_2d(I,j) = trans_x_2d(I,j) * Idt + endif + enddo ; enddo + endif + call post_data(tracer%id_dfx_2d, trans_x_2d(:,:), CS%diag) endif ! Diagnose vertically summed merid flux, giving meridional tracer transport from ndiff. ! Note sign corresponds to downgradient flux convention. if (tracer%id_dfy_2d > 0) then - do J = G%jsc-1,G%jec ; do i = G%isc,G%iec - trans_y_2d(i,J) = 0. - if (G%mask2dCv(i,J)>0.) then - do ks = 1,CS%nsurf-1 - trans_y_2d(i,J) = trans_y_2d(i,J) - Coef_y(i,J) * vFlx(i,J,ks) - enddo - trans_y_2d(i,J) = trans_y_2d(i,J) * Idt - endif - enddo ; enddo + + if (CS%KhTh_use_ebt_struct) then + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + trans_y_2d(i,J) = 0. + if (G%mask2dCv(i,J)>0.) then + do ks = 1,CS%nsurf-1 + trans_y_2d(i,J) = trans_y_2d(i,J) - vFlx(i,J,ks) + enddo + trans_y_2d(i,J) = trans_y_2d(i,J) * Idt + endif + enddo ; enddo + else + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + trans_y_2d(i,J) = 0. + if (G%mask2dCv(i,J)>0.) then + do ks = 1,CS%nsurf-1 + trans_y_2d(i,J) = trans_y_2d(i,J) - Coef_y(i,J,1) * vFlx(i,J,ks) + enddo + trans_y_2d(i,J) = trans_y_2d(i,J) * Idt + endif + enddo ; enddo + endif + call post_data(tracer%id_dfy_2d, trans_y_2d(:,:), CS%diag) endif @@ -2043,7 +2194,8 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K integer, dimension(nsurf), intent(in) :: KoR !< Index of first right interface above neutral surface real, dimension(nsurf-1), intent(in) :: hEff !< Effective thickness between two neutral !! surfaces [H ~> m or kg m-2] - real, dimension(nsurf-1), intent(inout) :: Flx !< Flux of tracer between pairs of neutral layers (conc H) + real, dimension(nsurf-1), intent(inout) :: Flx !< Flux of tracer between pairs of neutral layers + !! (conc H or conc H L2) logical, intent(in) :: continuous !< True if using continuous reconstruction real, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions [H ~> m or kg m-2] @@ -2051,8 +2203,8 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K !! to create sublayers real, optional, intent(in) :: h_neglect_edge !< A negligibly small width used for !! edge value calculations if continuous is false [H ~> m or kg m-2] - real, dimension(nk+1), optional, intent(in) :: coeff_l !< Left-column diffusivity [L2 T-1 ~> m2 s-1] - real, dimension(nk+1), optional, intent(in) :: coeff_r !< Right-column diffusivity [L2 T-1 ~> m2 s-1] + real, dimension(nk+1), optional, intent(in) :: coeff_l !< Left-column diffusivity [L2 ~> m2 or nondim] + real, dimension(nk+1), optional, intent(in) :: coeff_r !< Right-column diffusivity [L2 ~> m2 or nondim] ! Local variables integer :: k_sublayer, klb, klt, krb, krt From 2f34d6521e3799c3c51c031f98b51662e8f97c5b Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Fri, 18 Aug 2023 16:20:54 -0600 Subject: [PATCH 205/213] Merge latest mom-ocean main (#254) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Document and unit test for mu(z) in MLE parameterization - Renamed function from psi(z) to mu(sigma) - Added comments and units in function mu(sigma) - Added [numerical] unit tests for mu(z), including special limits, special values, and one test value (checked against a python script). * Adds the Bodner et al. 2023 version of MLE Changes: - Allow MLE parameterization to see surface buoyancy flux return from PBL scheme (affects MOM.F90, MOM_variables.F90:vertvisc_type, MOM_diabatic_driver.F90, MOM_set_viscosity.F90) - Adds the Bodner et al., 2023, parameterization of restratification by mixed-layer eddies to MOM_mixed_layer_restrat.F90 - This is a new subroutine rather than embedded inside the previous "OM4" version. It uses different inputs, different parameters, filters the BLD differently, - Renamed mixedlayer_restrat_general to mxiedlayer_restrat_OM4 to better distinguish the two versions. - Added function rmean2ts to extend the resetting running-mean time filter used in OM4 to use different time scales when growing or decaying. While mathematically the same in the limit of a zero "growing" time-scale, the implementation differs in the use of a reciprocal instead of division so was not added to the OM4 version. - Updated module documentation Co-authored-by: Abigail Bodner * Add Bodner MLE testing This patch adds the Bodner MLE testing parameters to the tc2.a test. * +Add Pa_to_RL2_T2 and Pa_to_RLZ_T2 to US type Add the combined unit scaling factors Pa_to_RL2_T2 and Pa_to_RLZ_T2 to the unit_scale_type to rescale pressures and wind stresses. All answers are bitwise identical, but there are two new elements in a public type. * Use US%Pa_to_RL2_T2 to rescale pressures Use the new combined unit scaling factor US%Pa_to_RL2_T2 to rescale input pressure fields and US%Pa_to_RLZ_T2 to rescale input wind stresses in various places in the MOM6 code, including in the solo_driver and FMS_cap drivers. Analogous changes could also be made to the mct and nuopc surface forcing files, but have been omitted for now. All answers are bitwise identical. * +Add runtime parameter TAUX_MAGNITUDE Added the new runtime parameter TAUX_MAGNITUDE to set the strength of the zonal wind stresses when WIND_CONFIG = "2gyre", "1gyre" or "Neverworld", with a default that matches the previous hard-coded dimensional parameters that were used to specify the wind stresses in these cases. Also use US%Pa_to_RLZ_T2 to rescale wind stresses throughout solo_driver/MOM_surface_forcing.F90. By default, all answers are bitwise identical, but there is a new runtime parameter in the MOM_parameter_doc files for some test cases. * Correct MLD_EN_VALS rescaling Correct inconsistent dimensional rescaling of the input values of MLD_EN_VALS, setting them all to [R Z3 T-2 ~> J m-2] to reflect that these are energies associated with vertical turbulent mixing. This fixes a rescaling bug when these energies are set to non-default values at runtime, but all answers and output are bitwise identical when no rescaling is used. * Add better error handling to read_var_sizes Add better error handling to read_var_sizes when a missing file or missing variable is provided as an argument. Without this change the model fails with a segmentation fault on line 768 of MOM_io.F90 if a bad file or variable name is provided. With this change, a useful error message is returned. All answers are bitwise identical in all cases that worked previously. * Checksum unrescaled non-Boussinesq thicknesses Redid the scaling of 52 checksum or check_redundant calls for thickness or transports to use the MKS counterparts of the thickness units (i.e., m and m3/s or kg/m2 and kg/s, depending on the Boussinesq approximation), rather than always rescaling them to m or m3/s. In Boussinesq mode, everything remains the same, but in non-Boussinesq mode, this means that the model's actual variable are being checksummed and not a version that is rescaled by division by the (meaningless?) Boussinesq reference density. All solutions are bitwise identical, but some debugging output will change in non-Boussinesq mode. * (*)Use conversion factor for masscello diagnostic Use a conversion factor to rescale the units of masscello, just like every other diagnostic. This does not change the diagnostic itself, but it changes the order of the rescaling and the vertical remapping of this diagnostic onto other coordinates (like z) or spatial averaging of this diagnostic, which can change values in the last bits for this diagnostic for Boussinesq models (but not for non-Boussinesq models, for which the conversion factor is an integer power of 2). As a result some of the diagnostics derived from masscello can differ and this commit nominally fails the TC testing for reproducibility across code versions. All solutions and primary diagnostics, however, are bitwise identical, and even the derived diagnostic calculations are mathematically equivalent. * +Remove rescaling factors from restart files Remove the code to account for unit rescaling within the restart files. This rescaling within the restart files has not been used in the code since March, 2022, and the model will work with older restart files provided that they did not use dimensional rescaling, and even if they did they can be converted not to use rescaling with a short run with the older code that created them. Also removed the publicly visible routines fix_restart_scaling and eliminated the m_to_H_restart element of the verticalGrid_type; in any cases of non-standard code using this element, it should be replaced with 1.0. The various US%..._restart elements and fix_restart_unit_scaling are being retained for now because they are still being used in the SIS2 code. These changes significantly simplify the code, and they lead to a handful of constants that are always 1 not being included in the MOM6 restart files. All answers are bitwise identical, but a publicly visible interface has been eliminated, as has been an element (GV%m_to_H_restart) of a transparent type. * +Add MOM_EOS_Wright_Full Added the new module MOM_EOS_Wright_full to enable the use of the version of the Wright equation of state that has been fit over the larger range of temperatures (-2 degC to 40 degC), salinities (0 psu to 40 psu) and pressures (0 dbar to 10000 dbar), than the does the restricted range fit in MOM_EOS_Wright, which had been fit over the range of (-2 degC to 30 degC), (28 psu to 38 psu) and (0 to 5000 dbar). Comments have been added to both modules to clearly document the range of properties over which they have been fitted. The new equation of state is enabled by setting EQN_OF_STATE = "WRIGHT_FULL". In addition, the default values for TFREEZE_FORM and EOS_QUADRATURE were changed depending on the equation of state to avoid having defaults that lead to fatal errors. All answers are bitwise identical in any cases that currently work, but there are new entries in the MOM_parameter_doc files. For now, only the coefficients have been changed between MOM_EOS_Wright and MOM_EOS_Wright_full, but this means that it does not yet have all of the parentheses that it should, as github.com/mom-ocean/MOM6/issues/1331 discusses. A follow up PR should add appropriate self-consistency and reference value checks (with a tolerance) for the various EOS routines, and then add enough parentheses to specify the order of arithmetic and hopefully enhance the accuracy. Ideally this can be done with the new equation of state before it starts to be widely used, so that we can avoid needing a extra code to reproduce the older answers. * Fix and tidy Wright_EOS API documentation Cleaned up the comments describing the routines and added a proper doxygen namespace block at the end of the MOM_EOS_Wright and MOM_EOS_Wright_full modules, based on changes that A. Adcroft had on a detached branch of MOM6. Only comments are changed, and all answers are bitwise identical. * (*)Rearranged parentheses in MOM_EOS_Wright_full Added parentheses to all expressions with three or more additions or multiplications in the MOM_EOS_Wright_full code, so that different compilers and compiler settings will reproduce the same answers in more cases. In doing this, an effort was made to add the smallest terms first to reduce the impact of roundoff. In some cases, the code was deliberately rearranged to cancel out the leading order terms more completely. In addition, two bugs had been identified in calculate_density_second_derivs_wright_full. These were corrected and the entire routine substantially refactored with renamed variables to make the derivation easier to follow and verify. Apart from the bug corrections in the calculation of drho_dt_dt and drho_dt_dp, the changes in the expressions are mathematically equivalent, but they might make the model less noisy in some cases by reducing contributions from round-off errors. Also added comments highlighting two bugs in the drho_dt_dt and drho_dt_dp calculations in calculate_density_second_derivs_wright in the original MOM_EOS_Wright code, but did not correct them to preserve the previous answers. * +Created the new module MOM_EOS_Wright_red Created a new module, MOM_EOS_Wright_red, that uses the reduced range fit coefficients from the Wright EOS paper, but uses the parentheses, expressions and bug fixes that are now in MOM_EOS_Wright_full. To use this new module, set EQN_OF_STATE="WRIGHT_RED". This new form is mathematically equivalent using EQN_OF_STATE="WRIGHT" (apart from correcting the bugs in the calculations of drho_dt_dt and drho_dt_dp), but the order of arithmetic is different, so the answers will differ. This change is probably as close as we can come to addressing the issues discussed at github.com/mom-ocean/MOM6/issues/1331, so that issue should be closed once this commit is merged onto the main branch. Also corrected some misleading error messages in MOM_EOS and modified the code to properly handle the case for equations of state (like NEMO and UNESCO) that do not have a scalar form of calculate_density_derivs, but do have an array form. By default, all answers are bitwise identical. * *Fix bug in calculate_spec_vol_linear with spv_ref Corrected a sign error in calculate_spec_vol_array_linear and calculate_spec_vol_scalar_linear when a reference specific volume is provided. This bug will cause any configurations with EQN_OF_STATE="LINEAR" and BOUSSINESQ=False (neither of which is the default value) to have the wrong sign of the pressure gradients and other serious problems, like implausible sea surface and internal interface heights. This combination of parameters would never be used in a realistic ocean model. There are no impacted cases in any of the MOM6-examples tests cases, nor those used in the ESMG or dev/NCAR test suites, and it is very unlikely that any such case would work at all. This bug was present in the original version of the calculate_spec_vol_linear routines, but it was only discovered after the implementation of the comprehensive equation of state unit testing. This will change answers in configurations that could not have worked as viable ocean models, but answers are not impacted in any known configuration, and all solutions in test cases are bitwise identical. * +Add EOS_unit_tests Added the new publicly visible function EOS_unit_tests, along with a call to it from inside of unit_tests. These tests evaluate check values for density and assess the consistency of expressions for variables that can be derived from density with finite-difference estimates of the same variables. These tests reveal inconsistencies or omissions with several of the options for the equation of state. The EOS self-consistency tests that are failing are commented out for now, so that this redacted unit test passes. All answers are bitwise identical, but there can be new diagnostic messages written out. * Fix doxygen labels in EOS_Wright_full and _red Changed recently added doxygen labels in the two newly added EOS_Wright_red and EOS_Wright_full modules to avoid reusing names that were already being used by EOS_Wright. All answers are bitwise identical, but the doxygen testing that had been failing for the previous 5 commits is working again. * *+NEMO equation of state self-consistency Corrected numerous issues with the NEMO equation of state so that it is now self consistent: - Modified how coefficients are set in MOM_EOS_NEMO so that they are guaranteed to be internally self-consistent, as verified by the EOS unit tests confirming that the first derivatives of density with temperature and salinity are now consistent with the equation of state. Previously these had only been consistent to about 7 decimal places, and hence the EOS unit tests were failing for the NEMO equation of state. - Added new public interfaces to calculate_density_second_derivs_NEMO, which had previously been missing. - Added code for calculate_compress_nemo that is explicitly derived from the NEMO EOS. The previous version of calculate_compress_nemo had worked only approximately via a call to the gsw package With these changes, the NEMO EOS routines are now passing the consistency testing in the EOS unit tests. Answers will change for configurations that use the NEMO EOS to calculate any derivatives, and there are new public interfaces, but it does not appear that the NEMO equation of state is in use yet, at least it is not being used at EMC, FSU, GFDL, NASA GSFC, NCAR or in the ESMG configurations. This commit addresses the issue raised at github.com/mom-ocean/MOM6/issues/405. * +Add calculate_density_second_derivs_UNESCO Added the new public interface calculate_density_second_derivs_UNESCO, which is an overload for both scalar and array versions, to calculate the second derivatives of density with various combinations of temperature, salinity and pressure. Also added a doxygen block at the end of MOM_EOS_UNESCO.F90 to describe this module and the papers it draws upon. Also replaced fatal errors in MOM_EOS with calls to these new routines. All answers are bitwise identical, but there are newly permitted combinations of options that previously failed. * (*)+Added calc_density_second_derivs_wright_buggy Added the new public interface calc_density_second_derivs_wright_buggy to reproduce the existing answers and corrected bugs in the calculation of the second derivatives of density with temperature and with temperature and pressure in in calculate_density_second_derivs_wright. Also added the new runtime parameter USE_WRIGHT_2ND_DERIV_BUG to indicate that the older (buggy) version of calculate_density_second_derivs_wright is to be used. Most configurations will not be impacted, but by default answers will change with configurations that use the Wright equation of state and one of the Stanley or similar nonlinear EOS parameterizations, unless USE_WRIGHT_2ND_DERIV_BUG is explicitly set to True. This commit also activates the self-consistency unit testing with the Wright equation of state (now that it passes) and limited unit testing of the TEOS-10 equation of state, omitting the second derivative calculations, one of which is failing (the second derivative of density with salinity and pressure) due to a bug in the TEOS10/gsw code. Also added a unit test for consistency of the density and specific volume when an offset reference value is used. * *Refactor MOM_EOS_UNESCO.F90 Refactored the expressions in MOM_EOS_UNESCO.F90, adding parentheses to specify the order of arithmetic, starting with the highest-order terms first for less sensitivity to round-off. Also added comments to better describe the references for these algorithms. Although the revised expressions are all mathematically equivalent, this commit will change answers for any cases that use EQN_OF_STATE = "UNESCO". However, it is believed based on a survey of the MOM6 community that there are no active configurations that use this equation of state. * *Refactor MOM_EOS_NEMO.F90 Refactored the expressions in MOM_EOS_NEMO.F90, adding parentheses to specify the order of arithmetic, starting with the highest-order terms first for less sensitivity to round-off. A number of internal variables were also renamed for greater clarity, and a number of comments were revised to better describe the references for these algorithms.. Although the revised expressions are all mathematically equivalent, this commit will change answers for any cases that use EQN_OF_STATE = "NEMO". However, there is another recent commit to this file that also changes answers (specifically the density derivatives) with this equation of state, and it is believed based on a survey of the MOM6 community that there are no active configurations that use this equation of state. * +Add MOM_EOS_Roquet_SpV.F90 Added the new equation of state module MOM_EOS_Roquet_SpV with the polynomial specific volume fit equation of state from Roquet et al. (2015). This equation of state has also been added to MOM_EOS, where it is enabled by setting EQN_OF_STATE="ROQUET_SPV". Two other new valid settings have been added to EQN_OF_STATE, "ROQUET_RHO" and "JACKETT_MCD", which synonymous with "NEMO" and "UNESCO" respectively, but more accurately reflect the publications that describe these fits to the equation of state. The EoS unit tests are being called for the new equation of state (it passes). By default, all answers are bitwise identical, but there are numerous new publicly visible interfaces. * +Add MOM_EOS_Jackett06.F90 Added the new equation of state module MOM_EOS_Jackett06 with the rational function equation of state from Jackett et al. (2006). This uses potential temperature and practical salinity as state variables, but with a fit to more up-to-date observational data than Wright (1997) or UNESCO / Jackett and McDougall (1995). This equation of state has also been added to MOM_EOS, where it is enabled by setting EQN_OF_STATE="JACKETT_06". The EoS unit tests are being called for the new equation of state (it passes). This commit also adds slightly more output from successful EoS unit tests when run with typical levels of verbosity. By default, all answers are bitwise identical, but there are numerous new publicly visible interfaces. * *+Add calculate_specvol_derivs_UNESCO Added the routine calculate_specvol_derivs_UNESCO to calculate the derivatives of specific volume with temperature and salinity to the MOM_EOS_UNESCO module. Also added some missing parentheses elsewhere in this module so that the answers will be invariant to complier version and optimization levels. Also revised the internal nomenclature of the parameters in this module to follow the conventions of the other EOS modules. Although the revised expressions are mathematically equivalent, this commit will change answers for any cases that use EQN_OF_STATE = "UNESCO". However, it is believed based on a survey of the MOM6 community that there are no active configurations that use this equation of state. There is a new publicly visible routine. * +Add EOS_fit_range and analogs for each EoS Added the new publicly visible subroutine EOS_fit_range and equivalent routines for each of the specific equation of state modules to return the range of temperatures, salinities, and pressures over which the observed data have been fitted. This is also tested for in test_EOS_consistency to indicate whether a test value is outside of the fit range, but the real purpose will be to flag and then figure out how to deal with the case when the ocean model is called with properties for which the equation of state is not valid. Note that as with all polynomial or other functional fits, extrapolating far outside of the fit range is likely to lead to bad values, but things may not be so bad for values that are only slightly outside of this range. However the question of how far out of the fit range these EoS expressions become inappropriate for each of temperature, salinity and pressure is as yet unresolved. All answers and output are bitwise identical, but there are 10 new public interfaces. * Do not include MOM_memory.h in EoS modules Removed unused and unnecessary #include statements from 5 equation of state modules. All answers are bitwise identical. * *Refactor calculate_specific_vol_wright_full Refactored the specific volume calculations for the WRIGHT_FULL and WRIGHT_RED equations of states for simplicity or to reduce the impacts of roundoff when removing a reference value. Also added code to multiply by the reciprocal of the denominator rather than dividing in several places in the int_spec_vol_dp routines for these same two equations of state, both for efficiency and greater consistency across optimization levels. These changes are mathematically equivalent but will change answers at roundoff with these two equations of state, but they are so new that they can not have been used yet. * +Renamed MOM_EOS_NEMO to MOM_EOS_Roquet_rho Renamed the module MOM_EOS_NEMO to MOM_EOS_Roquet_rho to more accurately reflect its provenance, although setting either EQN_OF_STATE = NEMO or EQN_OF_STATE = ROQUET_RHO will still work for using this code. All answers are bitwise identical, and previous input files will still work, but there are some minor changes in the MOM_parameter_doc files. * *Avoid re-rescaling T and p in MOM_EOS_Roquet_rho Refactored MOM_EOS_Roquet_rho and MOM_EOS_Roquet_SpV to work directly with conservative temperatures in [degC] and pressures in [Pa] rather than normalizing them as in the original Roquet publication. However, the coefficients are still set using the values directly copied from that paper, but rescaled where they are declared as parameters, enabling (or requiring) compilers to precalculate them during compilation. These changes are mathematically equivalent but will change answers at roundoff with these two equations of state, but they are not believed to be in use yet. * +Add calculate_TFreeze_TEOS_poly Added the overloaded interface calculate_TFreeze_TEOS_poly to MOM_TFreeze to use the 23-term polynomial expression from TEOS-10 for the freezing point in conservative temperature as a function of pressure and absolute salinity. This gives results that agrees to within about 5e-4 degC with the algorithm used by calculate_TFreeze_TEOS10, which calls the gsw TEOS10 code that does an iterative inversion of a balance of chemical potentials to find the freezing point (see the TEOS10 documentation for more details). Also added testing for the freezing point calculations to the EOS_unit tests via the new internal subroutine test_TFr_consistency. This new freezing point calculation is invoked by setting TFREEZE_FORM = TEOS_POLY. By default, all answers are bitwise identical, but there are some minor changes in the comments in some MOM_parameter_doc files, and there are several new interfaces. * +*Add MOM_temperature_convert.F90 Added the new module MOM_temperature_convert, which contains the elemental functions poTemp_to_consTemp and consTemp_to_poTemp to convert potential temperature to conservative temperature and the reverse. These routines are mathematically equivalent to the TEOS-10 functions gsw_ct_from_pt and gsw_pt_from_ct, but with some refactoring and added parentheses to help ensure identical answers across compilers or levels of optimization. Also added the new subroutines pot_temp_to_cons_temp and prac_saln_to_abs_saln, and added the new optional argument use_TEOS to convert_temp_salt_for_TEOS10, and cons_temp_to_pot_temp and abs_saln_to_prac_saln. The equivalency between the new code and their gsw_ counterparts is demonstrated in new tests in the new function test_TS_conversion_consistency, which in turn is called from EOS_unit_tests. All answers are mathematically equivalent, but because of the choice to use the new code by default there could be changes at the level of roundoff in some cases that use conservative temperature as their state variable but initialize it from potential temperature. There are not any such cases yet in the MOM6-examples test suite, nor are there believed to be any such MOM6 configurations that are widely used. This commit introduces a new module and several new functions or subroutines with public interfaces. * Update _Equation_of_State.dox Updated _Equation_of_State.dox to reflect the new options for the equation of state and freezing point calculations. * +Eliminate use_TEOS arg to cons_temp_to_pot_temp Eliminate use_TEOS optional arguments that were recently added to cons_temp_to_pot_temp and 4 other thermodynamic variable conversion functions, along with calls to gsw_pt_to_ct and similar conversion functions. All answers in the MOM6-examples test suite are bitwise identical. * +Make calculate_density_array private Removed calculate_density_array from the overloaded public calculate_density interface, and similarly for the other EOS calculate_..._array routines, to help standardize how they are called. Calculate_density_derivs_array is the one exception is because it is being called from SIS2 and has to stay publicly visible for now. Additionally, the scalar and 1-d versions of the calculate_stanley_density routines were refactored to just use calculate_density and calculate_density_second_derivs call and avoid any EoS-specific logic, while the unused routine calculate_stanley_density_array is eliminated altogether. All answers are bitwise identical, including in extra tests that use the stanley_density routines. * +Rename WRIGHT_RED to WRIGHT_REDUCED Revised the setting EQN_OF_STATE to select the Wright equation of state with the reduced-range fit to "WRIGHT_REDUCED" (instead of "WRIGHT_RED") for greater clarity, in response to a comment in the review of the pull request with this sequence of code revisions. All answers are bitwise identical, but this changes the text for a recently added input parameter and it leads to changes in some comments in the MOM_parameter_doc files. * Removal of FMS1 I/O from FMS2 I/O infra This patch removes the calls to FMS1 I/O (fms_io_mod, mpp_io_mod) from the FMS2 infra layer, and now exclusively uses FMS2 for those operations. FMS2 I/O is currently restricted to files which use domains; files which do not use them are delegated to the native netCDF layer. The reasoning for this is that FMS is required to define the formatting of domain-decomposed I/O; for single-file I/O, this is not necessary. This does not remove all references to FMS1 I/O from MOM6, only those in the I/O layer. Several minor changes are included to accommodate the change: * MOM restart I/O now always reports its MOM domain. Previously, the domian was omitted when PARALLEL_RESTARTFILES was false, in order to trick FMS into handling this as a single file. We now generate a new domain with an IO layout of [1,1] when single-file restarts are requested. * The interface acceleration (g') was incorrectly set to the layer grid (Nk) rather than the interface grid (Nk+1). This did not appear to change any answers, but when Vertical_coordinate.nc was moved to the netCDF layer, it detected this error. This is fixed in this patch. * Remove FMS1 calls from MOM_domains_infra * Add .nc extension to ALE Vertical_coordinate. The `Vertical_coordinate.nc` files has two points of creation, MOM_coord_initialization and MOM_ALE. Having moved the file from the infra to netCDF I/O layer, the .nc extension is no longer automatically applied. The extension was explicitly added to `Vertical_coordinate` in MOM_coord_initialization, but not to MOM_ALE. This patch adds the extension. Thanks to Kate Hedstrom for detecting this and Keith Lindsay for the proposed fix. * +Remove optional argument eta_to_m from find_eta Eliminate the unused optional argument eta_to_m from the two find_eta routines for simplicity and code clarity. These were used during the transition of the units of the interface height variables, but they are now using [Z ~> m] units everywhere, with the unscaling occurring via conversion factors in the register_diag calls. All answers are bitwise identical, but there is al optional argument that is removed from a public interface. * +Initialize thicknesses in height units Pass arguments in height units rather than thickness units to most of the routines that initialize thickness or temperatures and salinities. These routines are already undoing this scaling and working in height units, and it is not possible to convert thicknesses to thickness units in non-Boussinesq mode until the temperatures and salinities are also known. The routines whose argument units are altered include: - initialize_thickness_uniform - initialize_thickness_list - DOME_initialize_thickness - ISOMIP_initialize_thickness - benchmark_initialize_thickness - Neverworld_initialize_thickness - circle_obcs_initialize_thickness - lock_exchange_initialize_thickness - external_gwave_initialize_thickness - DOME2d_initialize_thickness - adjustment_initialize_thickness - sloshing_initialize_thickness - seamount_initialize_thickness - dumbbell_initialize_thickness - soliton_initialize_thickness - Phillips_initialize_thickness - Rossby_front_initialize_thickness - user_initialize_thickness - DOME2d_initialize_temperature_salinity - ISOMIP_initialize_temperature_salinity - adjustment_initialize_temperature_salinity - baroclinic_zone_init_temperature_salinity - sloshing_initialize_temperature_salinity - seamount_initialize_temperature_salinity - dumbbell_initialize_temperature_salinity - Rossby_front_initialize_temperature_salinity - SCM_CVMix_tests_TS_init - dense_water_initialize_TS - adjustEtaToFitBathymetry Similar changes were made internally to MOM_temp_salt_initialize_from_Z to defer the transition to working in thickness units, although the appropriate call to convert_thickness does still occur within MOM_temp_salt_initialize_from_Z and the units of its arguments are not changed. The routine convert thickness was modified to work with a new input depth space input thickness argument and return a thickness in thickness units, and it is now being called after all of the routines to initialize thicknesses and temperatures and salinities, except in the few cases where the thickness are being specified directly in mass-based thickness units, as might happen when they are read from an input file. The new option "mass_file" is now a recognized option for the THICKNESS_CONFIG runtime parameter, and this information is passed in the new mass_file argument to initialize_thickness_from_file. The description of the runtime parameter THICKNESS_IC_RESCALE was updated to reflect this change. The unused thickness (h) argument to soliton_initialize_velocity was eliminated. The unused thickness (h) argument to determine_temperature was eliminated, as was the unused optional h_massless argument to the same function. This commit also rearranges the calls to do adjustments to the thicknesses to account for the presence of an ice shelf or to iteratively apply the ALE remapping to occur before the velocities are initialized, so that there is a clearer separation of the phases of the initialization. Also added optional height_units argument to ALE_initThicknessToCoord to specify that the coordinate are to be returned in height_units. If it is omitted or false, the previous thickness units are returned, but when called from MOM_initialize_state the new argument is being used. The runtime parameter CONVERT_THICKNESS_UNITS is no longer meaningful, so it has been obsoleted. All answers are bitwise identical, but there are multiple changes to the arguments to publicly visible subroutines or their units, and there are changes to the contents of the MOM_parameter_doc files. * +Add the new overloaded interface dz_to_thickness Renamed convert_thickness from MOM_state_initialization to dz_to_thickness_tv in MOM_density_integrals, so that it can be called from other lower-level modules. This new version also takes the tv%p_surf field into account and it has an optional halo_size argument, analogous to that in the other routines in the MOM_density_integrals module. The dz_to_thickness interface is overloaded so that it can also be used directly with temperature, salinity, and the equation of state type if the thermo_var_ptrs is not available. There is also a new and separate variant of this routine, dz_to_thickness_simple, that can be used in pure layered mode when temperature and salinity are not state variables, or (more dangerously) if it is not clear whether or not there is an equation of state. This simpler version is being kept separate from the main overloaded interface because its use may need to be revisited later in some cases. All answers are bitwise identical, but there are two new public interfaces, dz_to_thickness and dz_to_thickness_simple. * (*)Improve non-Boussinesq initialization This commit includes three distinct sets of changes inside of MOM_state_initialization.F90 to better handle the initialization of non-Boussinesq models, none of which change any answers in Boussinesq models. These include: - Refactored trim_for_ice to have a separate, simpler form appropriate for use in non-Boussinesq mode. The units of the min_thickness argument to cut_off_column top were also changed to thickness units. - Initialize_sponges_file was refactored to work in depth-space variables before using dz_to_thickness to convert to thicknesses, but also to properly handle the case where the input file has a different number of vertical layers than the model is using, in which case the previous version could have had a segmentation fault. - Code in MOM_temp_salt_initialize_from_Z was reordered to more clearly group it into distinct phases. It also uses the new dz_to_thickness routine to convert input depths into thicknesses. All answers are bitwise identical in all Boussinesq test cases and all test cases in the MOM6-examples regression suite, but answers could be changed and improved in some non-Boussinesq cases. * (*)Use dz_to_thickness in 4 user modules Use dz_to_thickness to convert vertical distances to layer thicknesses in the sponge initialization routines in the DOME2d_initialization, ISOMIP_initialization, dumbbell_initialization and dense_water_initialization modules, and also in MOM_initialize_tracer_from_Z. For the user modules, the presence or absence of an equation of state is known and handled properly, but MOM_initialize_tracer_from_Z works with the generic tracer code and it it outside of the scope of MOM6 code to provide any information about the equation of state or the state variables that would be needed to initialize a non-Boussinesq model properly from a depth-space input file. For now we are doing the best we can, but this should be revisited. All examples in existing test cases are bitwise identical, but answers could change (and be improved) in any non-Boussinesq variants of the relevant test cases. * Update the Gitlab .testing modules for c5 In preparation for the migration to C5, this patch updates the modules required to run the .testing suite. * POSIX: generic wrappers for all setjmp.h symbols This patch extends the generic wrappers of sigsetjmp to all of the *jmp wrapper functions in The C standard allows these to be defined as macros, rather than explicit functions, which cannot be referenced by Fortran C bindings, so we cannot assume that these functions exist, even when using a compliant libc. As with sigsetjmp, these functions are now disabled on default, and raise a runtime error if called by the program. Realistically, they will only be defined by an autoconf-configured build. This is required for older Linux distributions where libc does not define longjmp. * Autoconf: External FMS build configuration This patch modifies the `ac/deps` Makefile used to build the FMS depedency. The autoconf compilation is now done entirely outside of the `ac/deps/fms/src` directory. This keeps the FMS checkout unchanged and allows us to better track any development changes in that library during development. The .testing/Makefile was also modified to use existing rules in deps/Makefile rather than duplicating them. Dependency of the m4 directory is also now more explicit (albeit still somewhat incomplete). * Autoconf: Explicit MOM_memory.h configuration MOM6 requires an explicit MOM_memory.h header to define its numerical field memory layout. Previously, autoconf provided a flag to configure this with `--enable-*`, but was prone to two issues: * The binary choice of symmetric/nonsymmetric prevented use of static headers. * It was an incorrect use of `--enable-*`, which is intended to enable additional internal features; it is not used to select a mode. To address these issues, we drop the flag and replace it with an AC_ARG_VAR variable, MOM_MEMORY, which is a path to the file. This variable will default to dynamic symmetric mode, config_src/memory/dynamic_symmetric/MOM_memory.h so there should be no change for existing users. To the best of my knowledge, no one used the `--enable-*` flag, nor was it used in any automated systems (outside of .testing), so there should be no issue with dropping it. .testing/Makefile was updated to use MOM_MEMORY. * Profiling: subparameter parser support The very crude MOM_input parser in the automatic profiler did not support subparameters (e.g. MLE% ... %MLE), which caused an error when trying to read the FMS clock output. This patch adds the support, or at least enough support to avoid errors. * +*Redefine GV%Angstrom_H in non-Boussinesq mode Redefined GV%Angstrom_H in non-Boussinesq mode so that it is equal to GV%H_to_Z*GV%Angstrom_Z, just as it is in Boussinesq mode. This will change answers (slightly) in all cases with BOUSSINESQ = False. In addition, this commit adds the elements semi_Boussinesq, dZ_subroundoff, m2_s_to_HZ_T, HZ_T_to_m2_s and HZ_T_to_MKS to the verticalGrid_type. The first 3 new elements are used in rescaling vertical viscosities and diffusivities. The last two elements are set using the new runtime parameters SEMI_BOUSSINESQ and RHO_KV_CONVERT, which are only used or logged when BOUSSINESQ = False. All answers and output are identical in Boussinesq cases, but answers change and there are new runtime parameters in non-Boussinesq cases. * +Set_interp_answer_date and REGRIDDING_ANSWER_DATE Add the ability to set the answer date for the regridding code, including the addition of the new subroutine set_interp_answer_date and the new runtime parameter REGRIDDING_ANSWER_DATE to specify the code vintage to use with state- dependent vertical coordinates. There is also new optional argument to set_regrid_params. By default, all answers are bitwise identical, but there are new or modified public interfaces and there is a new entry in some MOM_parameter_doc files. * *+Revise non-Boussinesq find_coupling_coef calcs Restructure one of the find_coupling_coef calculations to draw out the stress-magnitude terms, in preparation for future steps to reduce the dependency on the Boussinesq reference density. Using a value of VERT_FRICTION_ANSWER_DATE that is below 20230601 recovers the previous answers with non-Boussinesq test cases, but this is irrelevant for Boussinesq test cases. This updated code is mathematically equivalent to the previous expressions but it does change answers at roundoff in non-Boussinesq cases for recent answer dates. There are modifications to some comments in MOM_parameter_doc files. * +Code to calculate layer averaged specific volumes Add routines to calculate and store the layer-averaged specific volume, along with code to do the unit testing of this new capability. The new public interfaces include avg_specific_vol, average_specific_vol, avg_spec_vol_Wright, avg_spec_vol_Wright_full, avg_spec_vol_Wright_red and avg_spec_vol_linear. There is also a new optional argument to test_EOS_consistency to control whether these new capabilties are tested for a particular equation of state. All answers are bitwise identical, and the new capabilities pass the unit testing for self consistency. * +Add thickness_to_dz and calc_derived_thermo Added the new overloaded interface thickness_to_dz to convert the layer thicknesses in thickness units [H ~> m or kg m-2] into vertical distances in [Z ~> m], with variants that set full 3-d arrays or an i-/k- slice. Also added a field (SpV_avg) for the layer-averaged specific volume to the thermo_vars_ptr type and the new subroutine calc_derived_thermo to set it. This new subroutine is being called after halo updates to the temperatures and salinities. The new runtime parameter SEMI_BOUSSINESQ was added to determine whether tv%SpV_avg is allocated and used; it is stored in GV%semi_Boussinesq. Also added the new element GV%dZ_subroundoff to the verticalGrid_type as a counterpart to GV%H_subroundoff but in height units. All answers are bitwise identical, but there is a new runtime parameter in some MOM_parameter_doc files, new elements in a transparent type and a new public interface. * wave structure computation into wave_speeds wave_speeds now computes the wave structures (eigenvectors) for each mode speed (eigenvalue) similarly to the wave_speed (singular) function. This is a replacement for the MOM_wave_structure function, which could be removed in a subsequent PR. Additional arrays for mode strucures and integral quantities are passed as output hence this is a breaking change for the call to wave_speeds. However it is only called once in diabatic_driver and is used exclusively for internal tides ray tracing. The dimensional solutions for the wave structures are now computed inside MOM_internal_tides, and new diagnostics are added. An out-of-bounds bug is also corrected for the computation of an averaged coriolis parameter. * remove wave_structure broken code * Autoconf: Better Unicode Python support in makedep The `open()` commands in `makedep` for reading Fortran source now includes an `errors=` argument for catching bytes outside of the file character set. Unknown characters are replaced with the "unknown" character (usually �) rather than raising an error. This avoids problems with Unicode characters and older Pythons which do not support them, as well as characters from legacy encodings which can cause errors in Unicode. Substitution does not break any behavior, since Unicode is only permitted inside of comment blocks and strings. This fixes several errors which were silent in `.testing` but were observed by some users which using autoconf to build their own executables. * Autoconf: Fix Python test and allow configuration The AC_PATH_PROGS macros used in Python testing were incorrectly using AC_MSG_ERROR in places where a missing value for PYTHON should be if the executable was not found. It also did not permit for a configurable PYTHON variable, since the autodetect was always run, even if PYTHON were set. This has been updated so that Python autodetection only runs if PYTHON is unset. It also correctly reports a failed configuration if PYTHON is not found. (It does not, however, test of PYTHON is actually a Python interpreter, but we can deal with that at a later date.) * Fix PGI runtime issue with class(*) - Some tests such as global_ALE_z crash under PGI (ncrc4.pgi20 or ncrc5.pgi227) with FATAL from PE 27: unsupported attribute type: get_variable_attribute_0d: file:INPUT/tideamp.nc- variable:GRID_X_T attribute: axis - PGI in general has issues with class(*) construct and in this case cannot recognize the axis argument to be a string. - This mod helps PGI recognize that the argument is a string. * Use fileset rather than threading for decompositon MOM IO was using the `threading` flag rather than `fileset` to determine whether a file should be forced as single file rather than domain-decomposed. This patch applies the correct flag. * FMS2 interpolation ID replaced with derived type All instances of an FMS ID to the internal interpolation content is replaced with a derived type containing additional metadata recording the field's origin filename and fieldname. This additional information is required in order to replicate the axis data from the field, which is no longer provided by FMS2. The abstraction of this type also allows us to either extend it or redefine it in other frameworks as needed in the future. This primarily affects the usage of the following functions: - init_external_field - time_interp_external - horiz_interp_and_extrap_tracer The following solvers are updated: - MOM_open_boundary - MOM_ice_shelf - MOM_oda_driver - MOM_MEKE - MOM_ALE_sponge - MOM_diabatic_aux Of these, OBC was the most significant. The integer handle (fid) was previously used to determine if each segment field was constant or (if negative) read from a file. After being replaced by the derived type, a new flag was added to make this determination. All of the coupled drivers have been modified, since they support time interpolation of T and S fields. - FMS - MCT - NUOPC The NUOPC driver also includes modifications to its CFC11 and CFC12 fields. Changes to the MOM CFC modules replaces an `id == -1`-like test, which is not used by the derived type. This check has been removed, and we now solely rely on the `present(cfc_handle)` test. While this could change behavior, there does not seem to be any scenario where init_external_field would return -1 but would be passed to the function. (But I may eat these words.) * FMS2: Remove MPP-based axis data access With removal of axis-based operations in FMS2 I/O, this patch removes references to these calls and replaces them with MOM `axes_info` types. References to FMS1 read into an `axistype`, but the contents are transferred to an `axis_info`. FMS2 directly populates the `axis_info` content. The `get_external_field_info` calls are modified to return `axis_info` rather than `axistype`. The redundant `get_axis_data` function is also removed from `MOM_interp_infra`, since `get_axis_info` provides an equivalent operation. Generally speaking, this is not an improvement of the codebase. The FMS1 layer does a redundant copy of data from `axistype` to `axis_info`. The FMS2 layer is significantly worse, and re-opens the file to read the axis data for each field! But if the intention is to leverage the existing API, then I don't think we have any choice at the moment. Assuming this is a relatively infrequent operation, this should not cause any measureable issues, but it needs to be watched carefully. * FMS2: Update time_interp_external functions This patch shifts all remaining time_interp_external functions from time_interp_external to equivalent ones in time_interp_external2. Internally, time-interpolated fields are initialized with `ongrid` set to `.true.`, and such fields are assumed to be on-grid. This seems to hold for all existing instances of `time_interp_external`, but needs to be monitored in the future somehow. * FMS2: Case-insensitive init_external_field The FMS1 implementation of init_external_field is case-insensitive, but the FMS2 implementation is case-sensitive, which can cause errors in older established input files. This patch sweeps through the fields of the input files and checks for a case-insensitive match (using lowercase()). This requires an additional open/close of the file. * Implementation of ZB sheme * Filters for ZB. Regression changed (FGR changed to amplitude) * Rotate test is passed. Regression changed (order of operatrions) * ZB submitted via PR * ZB: Response to the code review * Update icebergs source path in nolibs build The icebergs project now includes drivers and tests which can interfere with the coupled nolibs build, so we only pass its src directory to mkmf. * +Make units argument mandatory for get_param_real This commit includes changes to the get_param_real and log_param_real interfaces to make the units arguments mandatory. It also adds an optional unscale argument to the log_param_real interfaces. Without other changes in the previous commits, it will cause the MOM6 code to fail to compile. However, by itself this commit does not change any answers or output. * github workflows: update to use actions/checkout@v3 - Update actions/checkout from v2 to v3 (suggested at https://github.com/NCAR/MOM6/pull/231#issuecomment-1347224581 thanks to @jedwards4b) * FMS2: Safe inspection of unlimited dim name The FMS2 function `get_unlimited_dimension_name` raises a netCDF error if no unlimited dimension is found. This is problematic for legacy or externally created input files which may have not identifed their time axis as unlimited. This patch adds a new function, `find_unlimited_dimension_name` which mirrors the FMS2 function but returns an empty string if none are found. This is an internal function, not intended for use outside of the module. * +Refactor internal_tides interface Refactors the internal tide code in MOM_internal_tides and MOM_diabatic_driver to consolidate it in the MOM_internal_tides module and allow the control structure for that module to be made opaque. This includes moving the internal wave speed diagnostics and the call to wave_speeds or other code setting the internal wave speeds into propagate_int_tide. The get_param calls for INTERNAL_WAVE_CG1_THRESH and UNIFORM_TEST_CG were moved from the diabatic module to the MOM_internal_tides module. The wave_speed_CS and uniform_test_cg were removed from diabatic_CS and added to int_tide_CS. The Nb argument to propagate_int_tide has been made intent inout, as it is now usually set via the call to wave_speeds in that routine, but for certain tests it could use the value passed in from diabatic_driver. All answers are bitwise identical, but there are changes to public interfaces and types, and the order of some entries in the MOM_parameter_doc files and the available_diags files is changed for some cases. * +Add fluxes%tau_mag and forces%tau_mag Add new allocatable tau_mag arrays to the forcing and mech_forcing types to hold the magnitude of the wind stresses including gustiness contributions. There is also a new tau_mag diagnostic. This same information in tau_mag is being transformed into ustar, but these changes avoid division by the Boussinesq reference density (GV%Rho0), and allow for a more accurate calculation of derived fields when in non-Boussinesq mode, without having to multiply and divide by GV%Rho0. There is also a new optional tau_mag argument to extract_IOB_stresses to support these changes. These new arrays are not being used yet in the MOM6 solutions, but they are being allocated and populated in the routines that set the ustar fields, and they have been tested in changes to the modules that use ustar that will come in a subsequent commit. This commit also adds the new RLZ_T2_to_Pa element to the unit_scale_type to undo the scaling of wind stresses and it makes use of it in some of the new code. All answers are bitwise identical, but there are new arrays or elements in three transparent public types. * *+Fix problems in mixedlayer_restrat_Bodner Fixed several problems with the recently added Bodner mixed layer restratification parameterization code. - Corrected the dimensional rescaling in the expressions for psi_mag by adding a missing factor of US%L_to_Z. - A logical branch was added based on the correct mask for land or OBC points to avoid potentially ill-defined calculations of the magnitude of the Bodner parameterization streamfunction, some which were leading to NaNs. - Set a tiny but nonzero default value for MIN_WSTAR2 to avoid NaNs in some calculations of the streamfunction magnitude. - Revised the expression for dd within the mu function in a mathematically equivalent way to avoid any possibility of taking a fractional exponential power of a tiny negative number due to truncation errors, which was leading to NaNs in some cases while developing and debugging the other changes that are not included in this commit. This does not appear to change any answers in the existing test cases, perhaps because the mixed layer restratification "tail" is not being activated by setting TAIL_DH to be larger than 0. - Corrected or added variable units in comments in the mixedlayer_restrat control structure. These could change answers (and avoid NaNs) in some cases with USE_BODNER23=True, MLE_TAIL_DH > 0 or MLE%TAIL_DH > 0, and there will be changes to the MOM_parameter_doc files for some cases, but given how recently this code was added, it is expected that all answers are bitwise identical in the existing test cases. * FMS2: New interface to set/nullify_domain This patch adds wrappers to the set_domain and nullify_domain functions used in FMS1 for internal FMS IO operations. These are not used in FMS2, so the wrapper functions are empty. This is required to eliminate FMS1 IO dependencies in SIS2. * *Correct nuopc_cap tau_mag bug Correct a recently added bug in the expression for tau_mag in the nuopc_cap version of convert_IOB_to_forces, where CS%gust(i,j) was used in place of CS%gust_const, even though the 2-d array was not being set. This commit changes answers in some recent versions of the code back to what they had been previously, and it addresses concerns that had been raised with the first version of gfdl-candidate-2023-07-03 and its PR to the main version of MOM6. * Fms2 io read3d slice (#399) * Restore functionality for reading slices from 3d volumes in MOM_io - The recent MOM_io modifications in support of FMS2_io accidentally removed support for reading on-grid data (same horizontal grid as model) k-slices. This is needed in some configurations in the model state initialization. * Add FMS1 interfaces * Additional patches to enable reading ongrid state initialization data - read local 3d volume rather than attempting to slice ongrid data vertically. - Related bugfixes in MOM_io * Update MOM_variables.F90 --------- Co-authored-by: Alistair Adcroft Co-authored-by: Abigail Bodner Co-authored-by: Marshall Ward Co-authored-by: Robert Hallberg Co-authored-by: Marshall Ward Co-authored-by: Raphael Dussin Co-authored-by: Niki Zadeh Co-authored-by: Pavel Perezhogin Co-authored-by: Matthew Harrison Co-authored-by: Matthew Thompson --- .github/workflows/coupled-api.yml | 2 +- .github/workflows/coverage.yml | 2 +- .github/workflows/documentation-and-style.yml | 2 +- .github/workflows/expression.yml | 2 +- .github/workflows/macos-regression.yml | 2 +- .github/workflows/macos-stencil.yml | 2 +- .github/workflows/other.yml | 2 +- .github/workflows/perfmon.yml | 2 +- .github/workflows/regression.yml | 2 +- .github/workflows/stencil.yml | 2 +- .gitlab-ci.yml | 86 +- .gitlab/pipeline-ci-tool.sh | 14 +- .testing/Makefile | 41 +- .testing/tc2.a/MOM_tc_variant | 6 + .testing/tools/parse_fms_clocks.py | 54 +- ac/configure.ac | 87 +- ac/deps/Makefile | 25 +- ac/makedep | 5 +- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 91 +- .../mct_cap/mom_surface_forcing_mct.F90 | 19 +- config_src/drivers/nuopc_cap/mom_cap.F90 | 4 +- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 19 +- .../solo_driver/MESO_surface_forcing.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 139 +- .../solo_driver/user_surface_forcing.F90 | 9 +- config_src/infra/FMS1/MOM_coms_infra.F90 | 24 +- config_src/infra/FMS1/MOM_domain_infra.F90 | 31 +- config_src/infra/FMS1/MOM_interp_infra.F90 | 96 +- config_src/infra/FMS1/MOM_io_infra.F90 | 41 +- config_src/infra/FMS2/MOM_coms_infra.F90 | 23 +- config_src/infra/FMS2/MOM_domain_infra.F90 | 34 +- config_src/infra/FMS2/MOM_interp_infra.F90 | 157 +- config_src/infra/FMS2/MOM_io_infra.F90 | 1067 ++++++------ src/ALE/MOM_ALE.F90 | 14 +- src/ALE/MOM_hybgen_regrid.F90 | 2 +- src/ALE/MOM_regridding.F90 | 24 +- src/ALE/regrid_interp.F90 | 17 +- src/core/MOM.F90 | 145 +- src/core/MOM_PressureForce_FV.F90 | 2 +- src/core/MOM_barotropic.F90 | 30 +- src/core/MOM_checksum_packages.F90 | 6 +- src/core/MOM_density_integrals.F90 | 34 +- src/core/MOM_dynamics_split_RK2.F90 | 54 +- src/core/MOM_forcing_type.F90 | 70 +- src/core/MOM_interface_heights.F90 | 357 +++- src/core/MOM_open_boundary.F90 | 31 +- src/core/MOM_unit_tests.F90 | 6 + src/core/MOM_variables.F90 | 7 +- src/core/MOM_verticalGrid.F90 | 71 +- src/diagnostics/MOM_diagnostics.F90 | 11 +- src/diagnostics/MOM_obsolete_params.F90 | 1 + src/diagnostics/MOM_wave_speed.F90 | 257 ++- src/diagnostics/MOM_wave_structure.F90 | 793 --------- src/equation_of_state/MOM_EOS.F90 | 1442 ++++++++++++++--- src/equation_of_state/MOM_EOS_Jackett06.F90 | 590 +++++++ src/equation_of_state/MOM_EOS_NEMO.F90 | 432 ----- src/equation_of_state/MOM_EOS_Roquet_SpV.F90 | 813 ++++++++++ src/equation_of_state/MOM_EOS_Roquet_rho.F90 | 633 ++++++++ src/equation_of_state/MOM_EOS_TEOS10.F90 | 26 +- src/equation_of_state/MOM_EOS_UNESCO.F90 | 729 ++++++--- src/equation_of_state/MOM_EOS_Wright.F90 | 345 +++- src/equation_of_state/MOM_EOS_Wright_full.F90 | 1033 ++++++++++++ src/equation_of_state/MOM_EOS_Wright_red.F90 | 1033 ++++++++++++ src/equation_of_state/MOM_EOS_linear.F90 | 54 +- src/equation_of_state/MOM_TFreeze.F90 | 97 +- .../MOM_temperature_convert.F90 | 166 ++ src/equation_of_state/_Equation_of_State.dox | 86 +- src/framework/MOM_file_parser.F90 | 8 +- src/framework/MOM_horizontal_regridding.F90 | 41 +- src/framework/MOM_interpolate.F90 | 27 +- src/framework/MOM_io.F90 | 181 ++- src/framework/MOM_io_file.F90 | 28 +- src/framework/MOM_restart.F90 | 4 +- src/framework/MOM_unit_scaling.F90 | 42 +- src/framework/posix.F90 | 51 +- src/framework/posix.h | 16 +- src/ice_shelf/MOM_ice_shelf.F90 | 51 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 19 - .../MOM_coord_initialization.F90 | 8 +- .../MOM_state_initialization.F90 | 562 +++---- .../MOM_tracer_initialization_from_Z.F90 | 14 +- src/ocean_data_assim/MOM_oda_driver.F90 | 15 +- src/parameterizations/lateral/MOM_MEKE.F90 | 52 +- .../lateral/MOM_Zanna_Bolton.F90 | 978 +++++++++++ .../lateral/MOM_hor_visc.F90 | 30 + .../lateral/MOM_internal_tides.F90 | 215 ++- .../lateral/MOM_mixed_layer_restrat.F90 | 851 ++++++++-- .../vertical/MOM_ALE_sponge.F90 | 32 +- .../vertical/MOM_diabatic_aux.F90 | 7 +- .../vertical/MOM_diabatic_driver.F90 | 130 +- .../vertical/MOM_set_viscosity.F90 | 53 +- .../vertical/MOM_vert_friction.F90 | 20 +- src/tracer/MOM_CFC_cap.F90 | 29 +- src/tracer/MOM_neutral_diffusion.F90 | 2 +- src/tracer/MOM_offline_main.F90 | 44 +- src/tracer/MOM_tracer_Z_init.F90 | 17 +- src/tracer/boundary_impulse_tracer.F90 | 4 - src/user/DOME2d_initialization.F90 | 60 +- src/user/DOME_initialization.F90 | 6 +- src/user/ISOMIP_initialization.F90 | 89 +- src/user/Idealized_Hurricane.F90 | 6 +- src/user/MOM_controlled_forcing.F90 | 49 - src/user/Neverworld_initialization.F90 | 14 +- src/user/Phillips_initialization.F90 | 6 +- src/user/Rossby_front_2d_initialization.F90 | 14 +- src/user/SCM_CVMix_tests.F90 | 4 +- src/user/adjustment_initialization.F90 | 18 +- src/user/baroclinic_zone_initialization.F90 | 6 +- src/user/benchmark_initialization.F90 | 10 +- src/user/circle_obcs_initialization.F90 | 18 +- src/user/dense_water_initialization.F90 | 30 +- src/user/dumbbell_initialization.F90 | 50 +- src/user/dumbbell_surface_forcing.F90 | 2 +- src/user/external_gwave_initialization.F90 | 4 +- src/user/lock_exchange_initialization.F90 | 4 +- src/user/seamount_initialization.F90 | 18 +- src/user/sloshing_initialization.F90 | 6 +- src/user/soliton_initialization.F90 | 7 +- src/user/user_initialization.F90 | 7 +- 119 files changed, 11386 insertions(+), 4078 deletions(-) delete mode 100644 src/diagnostics/MOM_wave_structure.F90 create mode 100644 src/equation_of_state/MOM_EOS_Jackett06.F90 delete mode 100644 src/equation_of_state/MOM_EOS_NEMO.F90 create mode 100644 src/equation_of_state/MOM_EOS_Roquet_SpV.F90 create mode 100644 src/equation_of_state/MOM_EOS_Roquet_rho.F90 create mode 100644 src/equation_of_state/MOM_EOS_Wright_full.F90 create mode 100644 src/equation_of_state/MOM_EOS_Wright_red.F90 create mode 100644 src/equation_of_state/MOM_temperature_convert.F90 create mode 100644 src/parameterizations/lateral/MOM_Zanna_Bolton.F90 diff --git a/.github/workflows/coupled-api.yml b/.github/workflows/coupled-api.yml index 2c9fa32720..4a07c0b639 100644 --- a/.github/workflows/coupled-api.yml +++ b/.github/workflows/coupled-api.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index 358d48a7a7..9922840420 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/documentation-and-style.yml b/.github/workflows/documentation-and-style.yml index c171c538d5..3ca7f0e613 100644 --- a/.github/workflows/documentation-and-style.yml +++ b/.github/workflows/documentation-and-style.yml @@ -8,7 +8,7 @@ jobs: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/expression.yml b/.github/workflows/expression.yml index adedf630b9..5860d32e37 100644 --- a/.github/workflows/expression.yml +++ b/.github/workflows/expression.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/macos-regression.yml b/.github/workflows/macos-regression.yml index dc86a52212..422c50b68a 100644 --- a/.github/workflows/macos-regression.yml +++ b/.github/workflows/macos-regression.yml @@ -16,7 +16,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/macos-stencil.yml b/.github/workflows/macos-stencil.yml index 96240f31f8..36a5841bb2 100644 --- a/.github/workflows/macos-stencil.yml +++ b/.github/workflows/macos-stencil.yml @@ -16,7 +16,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/other.yml b/.github/workflows/other.yml index c992c8c6ec..2cba17ae76 100644 --- a/.github/workflows/other.yml +++ b/.github/workflows/other.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/perfmon.yml b/.github/workflows/perfmon.yml index 896b9d51d8..09b4d617a2 100644 --- a/.github/workflows/perfmon.yml +++ b/.github/workflows/perfmon.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/regression.yml b/.github/workflows/regression.yml index 15dcdbceb2..7cdd0a5cd6 100644 --- a/.github/workflows/regression.yml +++ b/.github/workflows/regression.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.github/workflows/stencil.yml b/.github/workflows/stencil.yml index 6f4a7b1790..c85945072c 100644 --- a/.github/workflows/stencil.yml +++ b/.github/workflows/stencil.yml @@ -11,7 +11,7 @@ jobs: working-directory: .testing steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: submodules: recursive diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 653734097b..6be281c8cd 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -21,7 +21,7 @@ before_script: p:merge: stage: setup tags: - - ncrc4 + - ncrc5 script: - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl @@ -31,7 +31,7 @@ p:merge: p:clone: stage: setup tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh create-job-dir #.gitlab/pipeline-ci-tool.sh clean-job-dir @@ -44,7 +44,7 @@ p:clone: s:work-space:pgi: stage: setup tags: - - ncrc4 + - ncrc5 needs: ["p:clone"] script: - .gitlab/pipeline-ci-tool.sh copy-test-space pgi @@ -52,7 +52,7 @@ s:work-space:pgi: s:work-space:intel: stage: setup tags: - - ncrc4 + - ncrc5 needs: ["p:clone"] script: - .gitlab/pipeline-ci-tool.sh copy-test-space intel @@ -60,7 +60,7 @@ s:work-space:intel: s:work-space:gnu: stage: setup tags: - - ncrc4 + - ncrc5 needs: ["p:clone"] script: - .gitlab/pipeline-ci-tool.sh copy-test-space gnu @@ -68,7 +68,7 @@ s:work-space:gnu: s:work-space:gnu-restarts: stage: setup tags: - - ncrc4 + - ncrc5 needs: ["p:clone"] script: - .gitlab/pipeline-ci-tool.sh copy-test-space gnu-rst @@ -82,7 +82,7 @@ compile:pgi:repro: stage: builds needs: ["p:clone"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh mrs-compile repro_pgi @@ -90,7 +90,7 @@ compile:intel:repro: stage: builds needs: ["p:clone"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh mrs-compile repro_intel @@ -98,7 +98,7 @@ compile:gnu:repro: stage: builds needs: ["p:clone"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh mrs-compile repro_gnu mrs-compile static_gnu @@ -106,7 +106,7 @@ compile:gnu:debug: stage: builds needs: ["p:clone"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh mrs-compile debug_gnu @@ -114,7 +114,7 @@ compile:gnu:ocean-only-nolibs: stage: builds needs: ["p:clone"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh nolibs-ocean-only-compile gnu @@ -122,7 +122,7 @@ compile:gnu:ice-ocean-nolibs: stage: builds needs: ["p:clone"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh nolibs-ocean-ice-compile gnu @@ -132,36 +132,36 @@ run:pgi: stage: run needs: ["s:work-space:pgi","compile:pgi:repro"] tags: - - ncrc4 + - ncrc5 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite pgi SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c5 --nodes=12 --time=15:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite pgi SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-pgi-SNL || ( echo Batch job did not complete ; exit 911 ) run:intel: stage: run needs: ["s:work-space:intel","compile:intel:repro"] tags: - - ncrc4 + - ncrc5 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite intel SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c5 --nodes=12 --time=15:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite intel SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-intel-SNL || ( echo Batch job did not complete ; exit 911 ) run:gnu: stage: run needs: ["s:work-space:gnu","compile:gnu:repro","compile:gnu:debug"] tags: - - ncrc4 + - ncrc5 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu SNLDT && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c5 --nodes=12 --time=15:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu SNLDT && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-SNLDT || ( echo Batch job did not complete ; exit 911 ) run:gnu-restarts: stage: run needs: ["s:work-space:gnu-restarts","compile:gnu:repro"] tags: - - ncrc4 + - ncrc5 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu R && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - sbatch --clusters=c5 --nodes=12 --time=15:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu R && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-R || ( echo Batch job did not complete ; exit 911 ) # GH/autoconf tests (duplicates the GH actions tests) @@ -173,7 +173,7 @@ actions:gnu: stage: tests needs: [] tags: - - ncrc4 + - ncrc5 before_script: - echo -e "\e[0Ksection_start:`date +%s`:submodules[collapsed=true]\r\e[0KCloning submodules" - git submodule init ; git submodule update @@ -181,19 +181,19 @@ actions:gnu: script: - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling executables" - cd .testing - - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan ; module load PrgEnv-gnu ; module unload netcdf gcc ; module load gcc/7.3.0 cray-hdf5 cray-netcdf + - module unload PrgEnv-gnu PrgEnv-intel PrgEnv-nvhpc ; module load PrgEnv-gnu ; module unload gcc ; module load gcc/12.2.0 cray-hdf5 cray-netcdf - make -s -j - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s + - sbatch --clusters=c5 --nodes=2 --time=0:10:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s - make WORKSPACE=$WORKSPACE test.summary actions:intel: stage: tests needs: [] tags: - - ncrc4 + - ncrc5 before_script: - echo -e "\e[0Ksection_start:`date +%s`:submodules[collapsed=true]\r\e[0KCloning submodules" - git submodule init ; git submodule update @@ -201,12 +201,12 @@ actions:intel: script: - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling executables" - cd .testing - - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan; module load PrgEnv-intel; module unload netcdf intel; module load intel/18.0.6.288 cray-hdf5 cray-netcdf + - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu ; module load PrgEnv-intel; module unload intel; module load intel-classic/2022.0.2 cray-hdf5 cray-netcdf - make -s -j - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s + - sbatch --clusters=c5 --nodes=2 --time=0:10:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s - make WORKSPACE=$WORKSPACE test.summary # Tests @@ -218,7 +218,7 @@ t:pgi:symmetric: stage: tests needs: ["run:pgi"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats pgi S @@ -226,7 +226,7 @@ t:pgi:non-symmetric: stage: tests needs: ["run:pgi"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats pgi N @@ -234,7 +234,7 @@ t:pgi:layout: stage: tests needs: ["run:pgi"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats pgi L @@ -242,7 +242,7 @@ t:pgi:params: stage: tests needs: ["run:pgi"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-params pgi allow_failure: true @@ -251,7 +251,7 @@ t:intel:symmetric: stage: tests needs: ["run:intel"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats intel S @@ -259,7 +259,7 @@ t:intel:non-symmetric: stage: tests needs: ["run:intel"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats intel N @@ -267,7 +267,7 @@ t:intel:layout: stage: tests needs: ["run:intel"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats intel L @@ -275,7 +275,7 @@ t:intel:params: stage: tests needs: ["run:intel"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-params intel allow_failure: true @@ -284,7 +284,7 @@ t:gnu:symmetric: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats gnu S @@ -292,7 +292,7 @@ t:gnu:non-symmetric: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats gnu N @@ -300,7 +300,7 @@ t:gnu:layout: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats gnu L @@ -308,7 +308,7 @@ t:gnu:static: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats gnu T @@ -316,7 +316,7 @@ t:gnu:symmetric-debug: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats gnu D @@ -324,7 +324,7 @@ t:gnu:restart: stage: tests needs: ["run:gnu-restarts"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-stats gnu R @@ -332,7 +332,7 @@ t:gnu:params: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-params gnu allow_failure: true @@ -341,7 +341,7 @@ t:gnu:diags: stage: tests needs: ["run:gnu"] tags: - - ncrc4 + - ncrc5 script: - .gitlab/pipeline-ci-tool.sh check-diags gnu allow_failure: true @@ -350,7 +350,7 @@ t:gnu:diags: cleanup: stage: cleanup tags: - - ncrc4 + - ncrc5 before_script: - echo Skipping usual preamble script: diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh index 641e9f6053..77409d29ef 100755 --- a/.gitlab/pipeline-ci-tool.sh +++ b/.gitlab/pipeline-ci-tool.sh @@ -2,7 +2,7 @@ # Environment variables set by gitlab (the CI environment) if [ -z $JOB_DIR ]; then - echo Environment variable "$"JOB_DIR should be defined to point to a unique directory for these scripts to use. + echo Environment variable "$"JOB_DIR should be defined to point to a unique directory for these scripts to use. echo '$JOB_DIR is derived from $CI_PIPELINE_ID in MOM6/.gitlab-ci.yml' echo 'To use interactively try:' echo ' JOB_DIR=tmp' $0 $@ @@ -138,7 +138,7 @@ nolibs-ocean-only-compile () { make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 sed -i '/FMS1\/.*\/test_/d' path_names - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names + ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc5-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) fi section-end nolibs-ocean-only-compile-$1 @@ -154,9 +154,9 @@ nolibs-ocean-ice-compile () { mkdir -p build-ocean-ice-nolibs-$1 cd build-ocean-ice-nolibs-$1 make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} + ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/icebergs/src ../src/{FMS1,coupler,ice_param,land_null,atmos_null} sed -i '/FMS1\/.*\/test_/d' path_names - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names + ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc5-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) fi section-end nolibs-ocean-ice-compile-$1 @@ -208,8 +208,10 @@ mrs-run-sub-suite () { clean-params $EXP_GROUPS clean-core-files $EXP_GROUPS if [[ "$3" == *"_nonsym"* ]]; then + set -e time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.$1 MEMORY=${3/_nonsym/_sym} MODE=$4 LAYOUT=$5 -s -j fi + set -e time make -f tools/MRS/Makefile.run $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j tar cf - `find $EXP_GROUPS -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/$1-$2-$3-$4-$5-stats -xf - tar cf - `find $EXP_GROUPS -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/$1-$2-$3-$4-$5-params -xf - @@ -291,7 +293,7 @@ run-suite () { # $2 is path of correct results to test against (relative to $STATS_REPO_DIR) compare-stats () { if [ "$#" -ne 2 ]; then echo "compare-stats needs 2 arguments" ; exit 911 ; fi - section-start-open compare-stats-$1-$2-$3-$4-$5 "Checking stats for '$1' against '$2'" + section-start-open compare-stats-$1-$2-$3-$4-$5 "Checking stats for '$1' against '$2'" # This checks that any file in the results directory is exactly the same as in regressions/ ( cd $JOB_DIR/$STATS_REPO_DIR/$1 ; md5sum `find * -type f` ) | ( cd $JOB_DIR/$STATS_REPO_DIR/$2 ; md5sum -c ) 2>&1 | sed "s/ OK/$GRN&$OFF/;s/ FAILED/$RED&$OFF/;s/WARNING/$RED&$OFF/" FAIL=${PIPESTATUS[1]} @@ -409,7 +411,7 @@ while [[ $# -gt 0 ]]; do # Loop through arguments cd $START_DIR arg=$1 shift - case "$arg" in + case "$arg" in -n | --norun) DRYRUN=1; echo Dry-run enabled; continue ;; +n | ++norun) diff --git a/.testing/Makefile b/.testing/Makefile index 8a79d86e0a..b877ecb5f2 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -246,7 +246,8 @@ COV_LDFLAGS := LDFLAGS="$(LDFLAGS_COVERAGE) $(LDFLAGS_DEPS) $(LDFLAGS_USER)" # Environment variable configuration build/symmetric/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) -build/asymmetric/Makefile: MOM_ENV=$(PATH_FMS) $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/asymmetric/Makefile: MOM_ENV=$(PATH_FMS) $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) \ + MOM_MEMORY=../../../config_src/memory/dynamic_nonsymmetric/MOM_memory.h build/repro/Makefile: MOM_ENV=$(PATH_FMS) $(REPRO_FCFLAGS) $(MOM_LDFLAGS) build/openmp/Makefile: MOM_ENV=$(PATH_FMS) $(OPENMP_FCFLAGS) $(MOM_LDFLAGS) build/target/Makefile: MOM_ENV=$(PATH_FMS) $(TARGET_FCFLAGS) $(MOM_LDFLAGS) @@ -260,7 +261,7 @@ build/unit/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) # Configure script flags build/symmetric/Makefile: MOM_ACFLAGS= -build/asymmetric/Makefile: MOM_ACFLAGS=--enable-asymmetric +build/asymmetric/Makefile: MOM_ACFLAGS= build/repro/Makefile: MOM_ACFLAGS= build/openmp/Makefile: MOM_ACFLAGS=--enable-openmp build/target/Makefile: MOM_ACFLAGS= @@ -331,32 +332,23 @@ FMS_ENV = \ FCFLAGS="$(FCFLAGS_FMS)" \ REPORT_ERROR_LOGS="$(REPORT_ERROR_LOGS)" -deps/lib/libFMS.a: deps/fms/build/libFMS.a - $(MAKE) -C deps lib/libFMS.a +deps/lib/libFMS.a: deps/Makefile deps/Makefile.fms.in deps/configure.fms.ac deps/m4 + $(FMS_ENV) $(MAKE) -C deps lib/libFMS.a -deps/fms/build/libFMS.a: deps/fms/build/Makefile - $(MAKE) -C deps fms/build/libFMS.a +deps/Makefile: ../ac/deps/Makefile | deps + cp ../ac/deps/Makefile deps/Makefile -deps/fms/build/Makefile: deps/fms/src/configure deps/Makefile.fms.in - $(FMS_ENV) $(MAKE) -C deps fms/build/Makefile +deps/Makefile.fms.in: ../ac/deps/Makefile.fms.in | deps + cp ../ac/deps/Makefile.fms.in deps/Makefile.fms.in -deps/Makefile.fms.in: ../ac/deps/Makefile.fms.in deps/Makefile - cp $< deps +deps/configure.fms.ac: ../ac/deps/configure.fms.ac | deps + cp ../ac/deps/configure.fms.ac deps/configure.fms.ac -# TODO: m4 dependencies? -deps/fms/src/configure: ../ac/deps/configure.fms.ac deps/Makefile $(FMS_SOURCE) | deps/fms/src - cp ../ac/deps/configure.fms.ac deps - cp -r ../ac/deps/m4 deps - $(MAKE) -C deps fms/src/configure - -deps/fms/src: deps/Makefile - make -C deps fms/src - -# Dependency init -deps/Makefile: ../ac/deps/Makefile - mkdir -p $(@D) - cp $< $@ +deps/m4: ../ac/deps/m4 | deps + cp -r ../ac/deps/m4 deps/ +deps: + mkdir -p deps #--- # The following block does a non-library build of a coupled driver interface to @@ -741,7 +733,8 @@ prof.p0: $(WORKSPACE)/work/p0/opt/clocks.json $(WORKSPACE)/work/p0/opt_target/cl python tools/compare_clocks.py $^ $(WORKSPACE)/work/p0/%/clocks.json: $(WORKSPACE)/work/p0/%/std.out - python tools/parse_fms_clocks.py -d $(@D) $^ > $@ + python tools/parse_fms_clocks.py -d $(@D) $^ > $@ \ + || !( rm $@ ) $(WORKSPACE)/work/p0/opt/std.out: build/opt/MOM6 $(WORKSPACE)/work/p0/opt_target/std.out: build/opt_target/MOM6 diff --git a/.testing/tc2.a/MOM_tc_variant b/.testing/tc2.a/MOM_tc_variant index d48fa53507..5a85c21aed 100644 --- a/.testing/tc2.a/MOM_tc_variant +++ b/.testing/tc2.a/MOM_tc_variant @@ -1,3 +1,9 @@ #override TOPO_CONFIG = "spoon" #override REMAPPING_SCHEME = "PPM_H4" #override REGRIDDING_COORDINATE_MODE = "SIGMA" +MLE_USE_PBL_MLD = True +MLE%USE_BODNER23 = True +MLE%BLD_DECAYING_TFILTER = 86400. +MLE%MLD_DECAYING_TFILTER = 259200. +MLE%BLD_GROWING_TFILTER = 300. +MLE%MLD_GROWING_TFILTER = 3600. diff --git a/.testing/tools/parse_fms_clocks.py b/.testing/tools/parse_fms_clocks.py index b57fc481ab..fd3e7179d7 100755 --- a/.testing/tools/parse_fms_clocks.py +++ b/.testing/tools/parse_fms_clocks.py @@ -60,23 +60,61 @@ def main(): print(json.dumps(config)) -def parse_mom6_param(param_file): +def parse_mom6_param(param_file, header=None): + """Parse a MOM6 input file and return its contents. + + param_file: Path to MOM input file. + header: Optional argument indicating current subparameter block. + """ params = {} for line in param_file: + # Remove any trailing comments from the line. + # NOTE: Exotic values containing `!` will behave unexpectedly. param_stmt = line.split('!')[0].strip() - if param_stmt: - key, val = [s.strip() for s in param_stmt.split('=')] - # TODO: Convert to equivalent Python types - if val in ('True', 'False'): - params[key] = bool(val) - else: - params[key] = val + # Skip blank lines + if not param_stmt: + continue + + if param_stmt[-1] == '%': + # Set up a subparameter block which returns its own dict. + + # Extract the (potentially nested) subparameter: [...%]param% + key = param_stmt.split('%')[-2] + + # Construct subparameter endline: %param[%...] + subheader = key + if header: + subheader = header + '%' + subheader + + # Parse the subparameter contents and return as a dict. + value = parse_mom6_param(param_file, header=subheader) + + elif header and param_stmt == '%' + header: + # Finalize the current subparameter block. + break + + else: + # Extract record from `key = value` entry + # NOTE: Exotic values containing `=` will behave unexpectedly. + key, value = [s.strip() for s in param_stmt.split('=')] + + if value in ('True', 'False'): + # Boolean values are converted into Python logicals. + params[key] = bool(value) + else: + # All other values are currently stored as strings. + params[key] = value return params def parse_clocks(log): + """Parse the FMS time stats from MOM6 output log and return as a dict. + + log: Path to file containing MOM6 stdout. + """ + clock_start_msg = 'Tabulating mpp_clock statistics across' clock_end_msg = 'MPP_STACK high water mark=' diff --git a/ac/configure.ac b/ac/configure.ac index dead0579a6..7ea1870816 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -39,14 +39,30 @@ AC_CONFIG_MACRO_DIR([m4]) srcdir=$srcdir/.. -# Default to symmetric grid -# NOTE: --enable is more properly used to add a feature, rather than to select -# a compile-time mode, so this is not exactly being used as intended. -MEM_LAYOUT=${srcdir}/config_src/memory/dynamic_symmetric -AC_ARG_ENABLE([asymmetric], - AS_HELP_STRING([--enable-asymmetric], [Use the asymmetric grid])) -AS_IF([test "$enable_asymmetric" = yes], - [MEM_LAYOUT=${srcdir}/config_src/memory/dynamic_nonsymmetric]) +# Configure the memory layout header + +AC_ARG_VAR([MOM_MEMORY], + [Path to MOM_memory.h header, describing the field memory layout: dynamic + symmetric (default), dynamic asymmetric, or static.] +) + +AS_VAR_IF([MOM_MEMORY], [], + [MOM_MEMORY=${srcdir}/config_src/memory/dynamic_symmetric/MOM_memory.h] +) + +# Confirm that MOM_MEMORY is named 'MOM_memory.h' +AS_IF([test $(basename "${MOM_MEMORY}") == "MOM_memory.h"], [], + [AC_MSG_ERROR([MOM_MEMORY header ${MOM_MEMORY} must be named 'MOM_memory.h'])] +) + +# Confirm that the file exists +AC_CHECK_FILE(["$MOM_MEMORY"], [], + [AC_MSG_ERROR([MOM_MEMORY header ${MOM_MEMORY} not found.])] +) + +MOM_MEMORY_DIR=$(AS_DIRNAME(["${MOM_MEMORY}"])) +AC_SUBST([MOM_MEMORY_DIR]) + # Default to solo_driver DRIVER_DIR=${srcdir}/config_src/drivers/solo_driver @@ -220,34 +236,56 @@ AC_COMPILE_IFELSE( ] ) +# Python interpreter test -# Verify that Python is available -AC_PATH_PROGS([PYTHON], [python python3 python2], [ - AC_MSG_ERROR([Could not find python.]) -]) AC_ARG_VAR([PYTHON], [Python interpreter command]) +AS_VAR_SET_IF([PYTHON], [ + AC_PATH_PROGS([PYTHON], ["$PYTHON"], [none]) +], [ + AC_PATH_PROGS([PYTHON], [python python3 python2], [none]) +]) +AS_VAR_IF([PYTHON], [none], [ + AC_MSG_ERROR([Python interpreter not found.]) +]) + -# Verify that makedep is available +# Makedep test AC_PATH_PROG([MAKEDEP], [makedep], [${srcdir}/ac/makedep]) AC_SUBST([MAKEDEP]) # Generate source list and configure dependency command -AC_SUBST([SRC_DIRS], - ["${srcdir}/src ${MODEL_FRAMEWORK} ${srcdir}/config_src/external ${DRIVER_DIR} ${MEM_LAYOUT}"] +AC_SUBST([SRC_DIRS], ["\\ + ${srcdir}/src \\ + ${MODEL_FRAMEWORK} \\ + ${srcdir}/config_src/external \\ + ${DRIVER_DIR} \\ + ${MOM_MEMORY_DIR}"] ) AC_CONFIG_COMMANDS(Makefile.dep, [make depend]) # POSIX verification tests -# These symbols may be defined as macros, making them inaccessible by Fortran. -# These three exist in modern BSD and Linux libc, so we just confirm them. -# But one day, we many need to handle them more carefully. -AX_FC_CHECK_BIND_C([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])]) -AX_FC_CHECK_BIND_C([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])]) -AX_FC_CHECK_BIND_C([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) +# Symbols in may be defined as macros, making them inaccessible by +# Fortran C bindings. `sigsetjmp` is known to have an internal symbol in +# glibc, so we check for this possibility. For the others, we only check for +# existence. + +# If the need arises, we may want to define these under a standalone macro. + +# Validate the setjmp symbol +AX_FC_CHECK_BIND_C([setjmp], + [SETJMP="setjmp"], [SETJMP="setjmp_missing"] +) +AC_DEFINE_UNQUOTED([SETJMP_NAME], ["${SETJMP}"]) + +# Validate the longjmp symbol +AX_FC_CHECK_BIND_C([longjmp], + [LONGJMP="longjmp"], [LONGJMP="longjmp_missing"] +) +AC_DEFINE_UNQUOTED([LONGJMP_NAME], ["${LONGJMP}"]) # Determine the sigsetjmp symbol. If missing, then point to sigsetjmp_missing. # @@ -263,6 +301,13 @@ for sigsetjmp_fn in sigsetjmp __sigsetjmp; do done AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["${SIGSETJMP}"]) +# Validate the siglongjmp symbol +AX_FC_CHECK_BIND_C([siglongjmp], + [SIGLONGJMP="siglongjmp"], [SETJMP="siglongjmp_missing"] +) +AC_DEFINE_UNQUOTED([SIGLONGJMP_NAME], ["${SIGLONGJMP}"]) + + # Verify the size of nonlocal jump buffer structs # NOTE: This requires C compiler, but can it be done with a Fortran compiler? AC_LANG_PUSH([C]) diff --git a/ac/deps/Makefile b/ac/deps/Makefile index 84d43eb26d..3263dde678 100644 --- a/ac/deps/Makefile +++ b/ac/deps/Makefile @@ -41,33 +41,36 @@ lib/libFMS.a: fms/build/libFMS.a cp fms/build/libFMS.a lib/libFMS.a cp fms/build/*.mod include - fms/build/libFMS.a: fms/build/Makefile - make -C fms/build libFMS.a - + $(MAKE) -C fms/build libFMS.a -fms/build/Makefile: Makefile.fms.in fms/src/configure - mkdir -p fms/build - cp Makefile.fms.in fms/src/Makefile.in +fms/build/Makefile: fms/build/Makefile.in fms/build/configure cd $(@D) && { \ - ../src/configure --srcdir=../src \ + ./configure --srcdir=../src \ || { \ if [ "${REPORT_ERROR_LOGS}" = true ]; then cat config.log ; fi ; \ false; \ } \ } +fms/build/Makefile.in: Makefile.fms.in | fms/build + cp Makefile.fms.in fms/build/Makefile.in -fms/src/configure: configure.fms.ac $(FMS_SOURCE) | fms/src - cp configure.fms.ac fms/src/configure.ac - cp -r m4 $(@D) - cd $(@D) && autoreconf -i +fms/build/configure: fms/build/configure.ac $(FMS_SOURCE) | fms/src + autoreconf fms/build +fms/build/configure.ac: configure.fms.ac m4 | fms/build + cp configure.fms.ac fms/build/configure.ac + cp -r m4 fms/build + +fms/build: + mkdir -p fms/build fms/src: git clone $(FMS_URL) $@ git -C $@ checkout $(FMS_COMMIT) +# Cleanup .PHONY: clean clean: diff --git a/ac/makedep b/ac/makedep index 439679f17d..225a241b93 100755 --- a/ac/makedep +++ b/ac/makedep @@ -4,9 +4,10 @@ from __future__ import print_function import argparse import glob +import io import os import re -import sys # used only to get path to current script +import sys # Pre-compile re searches @@ -255,7 +256,7 @@ def scan_fortran_file(src_file): """Scan the Fortran file "src_file" and return lists of module defined, module used, and files included.""" module_decl, used_modules, cpp_includes, f90_includes, programs = [], [], [], [], [] - with open(src_file, 'r') as file: + with io.open(src_file, 'r', errors='replace') as file: lines = file.readlines() for line in lines: match = re_module.match(line.lower()) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 88d2cb3f42..251f37290d 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -27,6 +27,7 @@ module MOM_surface_forcing_gfdl use MOM_grid, only : ocean_grid_type use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init +use MOM_interpolate, only : external_field use MOM_io, only : slasher, write_version_number, MOM_read_data use MOM_io, only : read_netCDF_data use MOM_io, only : stdout_if_root @@ -153,8 +154,10 @@ module MOM_surface_forcing_gfdl !! in inputdir/temp_restore_mask.nc and the field should !! be named 'mask' real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring [nondim] - integer :: id_srestore = -1 !< An id number for time_interp_external. - integer :: id_trestore = -1 !< An id number for time_interp_external. + type(external_field) :: srestore_handle + !< Handle for time-interpolated salt restoration field + type(external_field) :: trestore_handle + !< Handle for time-interpolated temperature restoration field type(forcing_diags), public :: handles !< Diagnostics handles @@ -345,7 +348,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Salinity restoring logic if (CS%restore_salt) then - call time_interp_external(CS%id_srestore, Time, data_restore, scale=US%ppt_to_S) + call time_interp_external(CS%srestore_handle, Time, data_restore, scale=US%ppt_to_S) ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice @@ -403,7 +406,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! SST restoring logic if (CS%restore_temp) then - call time_interp_external(CS%id_trestore, Time, data_restore, scale=US%degC_to_C) + call time_interp_external(CS%trestore_handle, Time, data_restore, scale=US%degC_to_C) if ( CS%trestore_SPEAR_ECDA ) then do j=js,je ; do i=is,ie if (abs(data_restore(i,j)+1.8*US%degC_to_C) < 0.0001*US%degC_to_C) then @@ -548,14 +551,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%Pa_to_RL2_T2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo else do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%Pa_to_RL2_T2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) @@ -621,13 +624,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, endif ! Set the wind stresses and ustar. - if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)) then + if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless) .and. associated(fluxes%tau_mag)) then call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=fluxes%ustar, & - gustless_ustar=fluxes%ustar_gustless) - elseif (associated(fluxes%ustar)) then - call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=fluxes%ustar) - elseif (associated(fluxes%ustar_gustless)) then - call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, gustless_ustar=fluxes%ustar_gustless) + mag_tau=fluxes%tau_mag, gustless_ustar=fluxes%ustar_gustless) + else + if (associated(fluxes%ustar)) & + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=fluxes%ustar) + if (associated(fluxes%ustar_gustless)) & + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, gustless_ustar=fluxes%ustar_gustless) + if (associated(fluxes%tau_mag)) & + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, mag_tau=fluxes%tau_mag) endif if (coupler_type_initialized(fluxes%tr_fluxes) .and. & @@ -671,7 +677,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points [L4 Z-1 T-1 ~> m3 s-1] net_mass_src, & ! A temporary of net mass sources [R Z T-1 ~> kg m-2 s-1]. - ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. + ustar_tmp, & ! A temporary array of ustar values [Z T-1 ~> m s-1]. + tau_mag_tmp ! A temporary array of surface stress magnitudes [R Z L T-2 ~> Pa] real :: I_GEarth ! The inverse of the gravitational acceleration [T2 Z L-2 ~> s2 m-1] real :: Kv_rho_ice ! (CS%Kv_sea_ice / CS%density_sea_ice) [L4 Z-2 T-1 R-1 ~> m5 s-1 kg-1] @@ -755,12 +762,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%Pa_to_RL2_T2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) enddo ; enddo else do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%Pa_to_RL2_T2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif @@ -775,12 +782,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ ! Set the wind stresses and ustar. if (wt1 <= 0.0) then call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, & - ustar=forces%ustar, tau_halo=1) + ustar=forces%ustar, mag_tau=forces%tau_mag, tau_halo=1) else call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, & - ustar=ustar_tmp, tau_halo=1) + ustar=ustar_tmp, mag_tau=tau_mag_tmp, tau_halo=1) do j=js,je ; do i=is,ie forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) + forces%tau_mag(i,j) = wt1*forces%tau_mag(i,j) + wt2*tau_mag_tmp(i,j) enddo ; enddo endif @@ -877,7 +885,7 @@ end subroutine convert_IOB_to_forces !! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign !! conventions, and putting the fields into arrays with MOM-standard sized halos. subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ustar, & - gustless_ustar, tau_halo) + gustless_ustar, mag_tau, tau_halo) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -897,6 +905,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without !! any contributions from gustiness [Z T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(inout) :: mag_tau !< The magintude of the wind stress at tracer points + !! including subgridscale variability and gustiness [R Z L T-2 ~> Pa] integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables @@ -911,10 +922,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real :: Irho0 ! Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1] real :: taux2, tauy2 ! squared wind stresses [R2 Z2 L2 T-4 ~> Pa2] real :: tau_mag ! magnitude of the wind stress [R Z L T-2 ~> Pa] - real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress units [R Z L T-2 Pa-1 ~> 1] real :: stress_conversion ! A unit conversion factor from Pa times any stress multiplier [R Z L T-2 Pa-1 ~> 1] - logical :: do_ustar, do_gustless + logical :: do_ustar, do_gustless, do_tau_mag integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, ish, ieh, jsh, jeh, Isqh, Ieqh, Jsqh, Jeqh, i0, j0, halo @@ -925,10 +935,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) IRho0 = US%L_to_Z / CS%Rho0 - Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z - stress_conversion = Pa_conversion * CS%wind_stress_multiplier + stress_conversion = US%Pa_to_RLZ_T2 * CS%wind_stress_multiplier - do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) + do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) ; do_tau_mag = present(mag_tau) wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & @@ -1021,13 +1030,13 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, endif ! endif for extracting wind stress fields with various staggerings endif - if (do_ustar .or. do_gustless) then + if (do_ustar .or. do_tau_mag .or. do_gustless) then ! Set surface friction velocity directly or as a function of staggering. ! ustar is required for the bulk mixed layer formulation and other turbulent mixing ! parametizations. The background gustiness (for example with a relatively small value ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. if (associated(IOB%stress_mag)) then - if (do_ustar) then ; do j=js,je ; do i=is,ie + if (do_ustar .or. do_tau_mag) then ; do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d) then if ((wind_stagger == CGRID_NE) .or. & @@ -1037,15 +1046,18 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0.0)) ) & gustiness = CS%gust(i,j) endif - ustar(i,j) = sqrt(gustiness*IRho0 + IRho0*Pa_conversion*IOB%stress_mag(i-i0,j-j0)) + if (do_tau_mag) & + mag_tau(i,j) = gustiness + US%Pa_to_RLZ_T2*IOB%stress_mag(i-i0,j-j0) + if (do_ustar) & + ustar(i,j) = sqrt(gustiness*IRho0 + IRho0*US%Pa_to_RLZ_T2*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (CS%answer_date < 20190101) then if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = sqrt(Pa_conversion*US%L_to_Z*IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + gustless_ustar(i,j) = sqrt(US%Pa_to_RLZ_T2*US%L_to_Z*IOB%stress_mag(i-i0,j-j0) / CS%Rho0) enddo ; enddo ; endif else if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = sqrt(IRho0 * Pa_conversion*IOB%stress_mag(i-i0,j-j0)) + gustless_ustar(i,j) = sqrt(IRho0 * US%Pa_to_RLZ_T2*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif endif elseif (wind_stagger == BGRID_NE) then @@ -1061,6 +1073,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag) + if (do_tau_mag) mag_tau(i,j) = gustiness + tau_mag if (CS%answer_date < 20190101) then if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0) else @@ -1073,6 +1086,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0.0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag) + if (do_tau_mag) mag_tau(i,j) = gustiness + tau_mag if (CS%answer_date < 20190101) then if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0) else @@ -1094,6 +1108,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag) + if (do_tau_mag) mag_tau(i,j) = gustiness + tau_mag if (CS%answer_date < 20190101) then if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0) else @@ -1174,17 +1189,17 @@ subroutine apply_force_adjustments(G, US, CS, Time, forces) real :: rDlon ! The magnitude of the change in longitude [degrees_E] and then its inverse [degrees_E-1] real :: cosA, sinA ! The cosine and sine of the angle between the grid and true north [nondim] real :: zonal_tau, merid_tau ! True zonal and meridional wind stresses [R Z L T-2 ~> Pa] - real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] logical :: overrode_x, overrode_y isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec - Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged overrode_x = .false. ; overrode_y = .false. - call data_override(G%Domain, 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x, scale=Pa_conversion) - call data_override(G%Domain, 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y, scale=Pa_conversion) + call data_override(G%Domain, 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, & + override=overrode_x, scale=US%Pa_to_RLZ_T2) + call data_override(G%Domain, 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, & + override=overrode_y, scale=US%Pa_to_RLZ_T2) if (overrode_x .or. overrode_y) then if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& @@ -1314,7 +1329,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "limit the water that can be frozen out of the ocean and "//& "the ice-ocean heat fluxes are treated explicitly. No "//& "limit is applied if a negative value is used.", & - units="Pa", default=-1.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=-1.0, scale=US%Pa_to_RL2_T2) call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, & "If true, the coupled driver will add a globally-balanced "//& "fresh-water flux that drives sea-surface salinity "//& @@ -1532,8 +1547,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", & - units="Pa", default=0.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) + "The background gustiness in the winds.", & + units="Pa", default=0.0, scale=US%Pa_to_RLZ_T2) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & "The file in which the wind gustiness is found in "//& @@ -1544,7 +1559,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) ! NOTE: There are certain cases where FMS is unable to read this file, so ! we use read_netCDF_data in place of MOM_read_data. call read_netCDF_data(gust_file, 'gustiness', CS%gust, G%Domain, & - rescale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa + rescale=US%Pa_to_RLZ_T2) ! units in file should be [Pa] endif call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & @@ -1612,7 +1627,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) if (CS%restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) - CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, MOM_domain=G%Domain) + CS%srestore_handle = init_external_field(salt_file, CS%salt_restore_var_name, MOM_domain=G%Domain) call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 if (CS%mask_srestore) then ! read a 2-d file containing a mask for restoring fluxes flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' @@ -1622,7 +1637,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) if (CS%restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) - CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, MOM_domain=G%Domain) + CS%trestore_handle = init_external_field(temp_file, CS%temp_restore_var_name, MOM_domain=G%Domain) call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 if (CS%mask_trestore) then ! read a 2-d file containing a mask for restoring fluxes flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index 0364d46ddc..ec5dab57a7 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -25,6 +25,7 @@ module MOM_surface_forcing_mct use MOM_grid, only : ocean_grid_type use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init +use MOM_interpolate, only : external_field use MOM_io, only : slasher, write_version_number, MOM_read_data use MOM_io, only : stdout use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS @@ -134,8 +135,10 @@ module MOM_surface_forcing_mct !! in inputdir/temp_restore_mask.nc and the field should !! be named 'mask' real, pointer, dimension(:,:) :: trestore_mask => NULL() !< mask for SST restoring - integer :: id_srestore = -1 !< id number for time_interp_external. - integer :: id_trestore = -1 !< id number for time_interp_external. + type(external_field) :: srestore_handle + !< Handle for time-interpolated salt restoration field + type(external_field) :: trestore_handle + !< Handle for time-interpolated temperature restoration field type(forcing_diags), public :: handles !< diagnostics handles type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer @@ -348,7 +351,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Salinity restoring logic if (restore_salinity) then - call time_interp_external(CS%id_srestore, Time, data_restore, scale=US%ppt_to_S) + call time_interp_external(CS%srestore_handle, Time, data_restore, scale=US%ppt_to_S) ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice @@ -405,7 +408,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! SST restoring logic if (restore_sst) then - call time_interp_external(CS%id_trestore, Time, data_restore, scale=US%degC_to_C) + call time_interp_external(CS%trestore_handle, Time, data_restore, scale=US%degC_to_C) do j=js,je ; do i=is,ie delta_sst = data_restore(i,j) - sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) @@ -771,6 +774,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif + forces%tau_mag(i,j) = gustiness + tau_mag forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo @@ -796,6 +800,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0.0)) gustiness = CS%gust(i,j) + forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2) forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -817,8 +822,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then + forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(taux2 + tauy2) forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else + forces%tau_mag(i,j) = CS%gust_const + sqrt(taux2 + tauy2) forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -1292,7 +1299,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (present(restore_salt)) then ; if (restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) - CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) + CS%srestore_handle = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 if (CS%mask_srestore) then ! read a 2-d file containing a mask for restoring fluxes flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' @@ -1302,7 +1309,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (present(restore_temp)) then ; if (restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) - CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) + CS%trestore_handle = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 if (CS%mask_trestore) then ! read a 2-d file containing a mask for restoring fluxes flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 2841c7196c..120078b11e 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -8,12 +8,12 @@ module MOM_cap_mod use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain use mpp_domains_mod, only: mpp_get_domain_npes -use MOM_time_manager, only: set_calendar_type, time_type, set_time, set_date, month_name +use MOM_time_manager, only: set_calendar_type, time_type, set_time, set_date use MOM_time_manager, only: GREGORIAN, JULIAN, NOLEAP use MOM_time_manager, only: operator( <= ), operator( < ), operator( >= ) use MOM_time_manager, only: operator( + ), operator( - ), operator( / ) use MOM_time_manager, only: operator( * ), operator( /= ), operator( > ) -use MOM_domains, only: MOM_infra_init, MOM_infra_end, num_pes, root_pe, pe_here +use MOM_domains, only: MOM_infra_init, MOM_infra_end use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file use MOM_get_input, only: get_MOM_input, directories use MOM_domains, only: pass_var diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index b921f7355d..054d42a084 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -26,6 +26,7 @@ module MOM_surface_forcing_nuopc use MOM_grid, only : ocean_grid_type use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init +use MOM_interpolate, only : external_field use MOM_io, only : slasher, write_version_number, MOM_read_data use MOM_io, only : stdout use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS @@ -142,8 +143,10 @@ module MOM_surface_forcing_nuopc !! in inputdir/temp_restore_mask.nc and the field should !! be named 'mask' real, pointer, dimension(:,:) :: trestore_mask => NULL() !< mask for SST restoring - integer :: id_srestore = -1 !< id number for time_interp_external. - integer :: id_trestore = -1 !< id number for time_interp_external. + type(external_field) :: srestore_handle + !< Handle for time-interpolated salt restoration field + type(external_field) :: trestore_handle + !< Handle for time-interpolated temperature restoration field ! Diagnostics handles type(forcing_diags), public :: handles @@ -369,7 +372,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Salinity restoring logic if (restore_salinity) then - call time_interp_external(CS%id_srestore, Time, data_restore, scale=US%ppt_to_S) + call time_interp_external(CS%srestore_handle, Time, data_restore, scale=US%ppt_to_S) ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice @@ -426,7 +429,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! SST restoring logic if (restore_sst) then - call time_interp_external(CS%id_trestore, Time, data_restore, scale=US%degC_to_C) + call time_interp_external(CS%trestore_handle, Time, data_restore, scale=US%degC_to_C) do j=js,je ; do i=is,ie delta_sst = data_restore(i,j) - sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) @@ -832,6 +835,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif + forces%tau_mag(i,j) = gustiness + tau_mag forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) @@ -857,6 +861,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0.0)) gustiness = CS%gust(i,j) + forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2) forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -878,8 +883,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then + forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(taux2 + tauy2) forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else + forces%tau_mag(i,j) = CS%gust_const + sqrt(taux2 + tauy2) forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -1381,7 +1388,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (present(restore_salt)) then ; if (restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) - CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) + CS%srestore_handle = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 if (CS%mask_srestore) then ! read a 2-d file containing a mask for restoring fluxes flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' @@ -1391,7 +1398,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (present(restore_temp)) then ; if (restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) - CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) + CS%trestore_handle = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 if (CS%mask_trestore) then ! read a 2-d file containing a mask for restoring fluxes flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 index 12f1b6b78d..a3007326b7 100644 --- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 @@ -242,7 +242,7 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", default=0.0, & - scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) + scale=US%Pa_to_RLZ_T2) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 522420e004..c99402446f 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -88,6 +88,8 @@ module MOM_surface_forcing !! forcing [R L Z T-2 ~> Pa] real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" !! forcing [R L Z T-2 ~> Pa] + real :: taux_mag !< Peak magnitude of the zonal wind stress for several analytic + !! profiles [R L Z T-2 ~> Pa] real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file @@ -406,10 +408,16 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie forces%ustar(i,j) = sqrt( US%L_to_Z * ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) enddo ; enddo ; endif + if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = mag_tau + CS%gust(i,j) + enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie forces%ustar(i,j) = sqrt( US%L_to_Z * ( mag_tau + CS%gust_const ) / CS%Rho0 ) enddo ; enddo ; endif + if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = mag_tau + CS%gust_const + enddo ; enddo ; endif endif call callTree_leave("wind_forcing_const") @@ -427,8 +435,6 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units - ! for wind stresses [R Z L T-2 Pa-1 ~> 1] real :: PI ! A common irrational number, 3.1415926535... [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -436,13 +442,11 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z PI = 4.0*atan(1.0) ! Set the steady surface wind stresses, in units of [R L Z T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = 0.1 * Pa_to_RLZ_T2 * & - (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) + forces%taux(I,j) = CS%taux_mag * (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) enddo ; enddo do J=js-1,Jeq ; do i=is,ie @@ -466,8 +470,6 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units - ! for wind stresses [R Z L T-2 Pa-1 ~> 1] real :: PI ! A common irrational number, 3.1415926535... [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -476,12 +478,10 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB PI = 4.0*atan(1.0) - Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z ! Set the steady surface wind stresses, in units of [R Z L T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = -0.2 * Pa_to_RLZ_T2 * & - cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) + forces%taux(I,j) = CS%taux_mag * cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) enddo ; enddo do J=js-1,Jeq ; do i=is,ie @@ -529,9 +529,11 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity if (CS%answer_date < 20190101) then do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = CS%gust_const + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) forces%ustar(i,j) = sqrt(US%L_to_Z * ((CS%gust_const/CS%Rho0) + & - sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + forces%tauy(i,j)*forces%tauy(i,j) + & - forces%taux(i-1,j)*forces%taux(i-1,j) + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0) ) + sqrt(0.5*(forces%tauy(i,J-1)*forces%tauy(i,J-1) + forces%tauy(i,J)*forces%tauy(i,J) + & + forces%taux(I-1,j)*forces%taux(I-1,j) + forces%taux(I,j)*forces%taux(I,j)))/CS%Rho0) ) enddo ; enddo else call stresses_to_ustar(forces, G, US, CS) @@ -554,8 +556,6 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units - ! for wind stresses [R Z L T-2 Pa-1 ~> 1] real :: PI ! A common irrational number, 3.1415926535... [nondim] real :: y ! The latitude relative to the south normalized by the domain extent [nondim] real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] @@ -575,9 +575,9 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. PI = 4.0*atan(1.0) - Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + forces%taux(:,:) = 0.0 - tau_max = 0.2 * Pa_to_RLZ_T2 + tau_max = CS%taux_mag off = 0.02 do j=js,je ; do I=is-1,Ieq y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat @@ -673,8 +673,6 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) character(len=200) :: filename ! The name of the input file. real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-2 ~> Pa] real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-2 ~> Pa] - real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units - ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and monthly cycles. integer :: time_lev ! The time level that is used for a field. @@ -685,7 +683,6 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) @@ -724,7 +721,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & temp_x(:,:), temp_y(:,:), G%Domain, stagger=AGRID, & - timelevel=time_lev, scale=Pa_to_RLZ_T2) + timelevel=time_lev, scale=US%Pa_to_RLZ_T2) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=js,je ; do I=is-1,Ieq @@ -737,11 +734,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt((CS%gust(i,j) + & - sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j))) * US%L_to_Z / CS%Rho0) + forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + forces%ustar(i,j) = sqrt(forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = CS%gust_const + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + & sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j)) / CS%Rho0) ) enddo ; enddo @@ -758,7 +756,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & temp_x(:,:), temp_y(:,:), & G%Domain_aux, stagger=CGRID_NE, timelevel=time_lev, & - scale=Pa_to_RLZ_T2) + scale=US%Pa_to_RLZ_T2) do j=js,je ; do i=is,ie forces%taux(I,j) = CS%wind_scale * temp_x(I,j) forces%tauy(i,J) = CS%wind_scale * temp_y(i,J) @@ -768,7 +766,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & forces%taux(:,:), forces%tauy(:,:), & G%Domain, stagger=CGRID_NE, timelevel=time_lev, & - scale=Pa_to_RLZ_T2) + scale=US%Pa_to_RLZ_T2) if (CS%wind_scale /= 1.0) then do j=js,je ; do I=Isq,Ieq @@ -784,15 +782,19 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt((CS%gust(i,j) + & - sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & - (forces%taux(i-1,j)**2 + forces%taux(i,j)**2))) ) * US%L_to_Z / CS%Rho0 ) + forces%tau_mag(i,j) = CS%gust(i,j) + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) + forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 ) enddo ; enddo else do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = CS%gust_const + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) forces%ustar(i,j) = sqrt(US%L_to_Z * ( (CS%gust_const/CS%Rho0) + & - sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & - (forces%taux(i-1,j)**2 + forces%taux(i,j)**2)))/CS%Rho0)) + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))/CS%Rho0)) enddo ; enddo endif endif @@ -804,6 +806,9 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (read_Ustar) then call MOM_read_data(filename, CS%Ustar_var, forces%ustar(:,:), & G%Domain, timelevel=time_lev, scale=US%m_to_Z*US%T_to_s) + do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = US%Z_to_L * CS%Rho0 * forces%ustar(i,j)**2 + enddo ; enddo endif CS%wind_last_lev = time_lev @@ -827,8 +832,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R Z L T-2 ~> Pa]. real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R Z L T-2 ~> Pa]. - real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units - ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: ustar_tmp(SZI_(G),SZJ_(G)) ! The pre-override value of ustar [Z T-1 ~> m s-1] integer :: i, j call callTree_enter("wind_forcing_by_data_override, MOM_surface_forcing.F90") @@ -839,12 +843,10 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) CS%dataOverrideIsInitialized = .True. endif - Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z - temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 ! CS%wind_scale is ignored here because it is not set in this mode. - call data_override(G%Domain, 'taux', temp_x, day, scale=Pa_to_RLZ_T2) - call data_override(G%Domain, 'tauy', temp_y, day, scale=Pa_to_RLZ_T2) + call data_override(G%Domain, 'taux', temp_x, day, scale=US%Pa_to_RLZ_T2) + call data_override(G%Domain, 'tauy', temp_y, day, scale=US%Pa_to_RLZ_T2) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=G%jsc,G%jec ; do I=G%isc-1,G%IecB forces%taux(I,j) = 0.5 * (temp_x(i,j) + temp_x(i+1,j)) @@ -854,19 +856,27 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) enddo ; enddo if (CS%read_gust_2d) then - call data_override(G%Domain, 'gust', CS%gust, day, scale=Pa_to_RLZ_T2) + call data_override(G%Domain, 'gust', CS%gust, day, scale=US%Pa_to_RLZ_T2) do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = sqrt((sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + & - CS%gust(i,j)) * US%L_to_Z / CS%Rho0) + forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust(i,j) + forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 ) enddo ; enddo else do j=G%jsc,G%jec ; do i=G%isc,G%iec + forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust_const + ! forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 ) forces%ustar(i,j) = sqrt(US%L_to_Z * (sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)/CS%Rho0 + & CS%gust_const/CS%Rho0)) enddo ; enddo endif + ! Give the data override the option to modify the newly calculated forces%ustar. + ustar_tmp(:,:) = forces%ustar(:,:) call data_override(G%Domain, 'ustar', forces%ustar, day, scale=US%m_to_Z*US%T_to_s) + ! Only reset values where data override of ustar has occurred + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ustar_tmp(i,j) /= forces%ustar(i,j)) then + forces%tau_mag(i,j) = US%Z_to_L * CS%Rho0 * forces%ustar(i,j)**2 + endif ; enddo ; enddo call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) @@ -891,15 +901,17 @@ subroutine stresses_to_ustar(forces, G, US, CS) if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( (CS%gust(i,j) + & - sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & - (forces%taux(i-1,j)**2 + forces%taux(i,j)**2))) ) * I_rho ) + forces%tau_mag(i,j) = CS%gust(i,j) + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) + forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * I_rho ) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( (CS%gust_const + & - sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & - (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) + forces%tau_mag(i,j) = CS%gust_const + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) + forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * I_rho ) enddo ; enddo endif @@ -1515,8 +1527,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! This include declares and sets the variable "version". # include "version_variable.h" real :: flux_const_default ! The unscaled value of FLUXCONST [m day-1] - real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units - ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover @@ -1539,8 +1549,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%diag => diag if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp - Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, '') call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & @@ -1563,6 +1571,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "If true, the buoyancy forcing varies in time after the "//& "initialization of the model.", default=.true.) + ! Determine parameters related to the buoyancy forcing. call get_param(param_file, mdl, "BUOY_CONFIG", CS%buoy_config, & "The character string that indicates how buoyancy forcing is specified. Valid "//& "options include (file), (data_override), (zero), (const), (linear), (MESO), "//& @@ -1705,6 +1714,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "through the sensible heat flux field. ", & units='W/m2', scale=US%W_m2_to_QRZ_T, fail_if_missing=.true.) endif + + ! Determine parameters related to the wind forcing. call get_param(param_file, mdl, "WIND_CONFIG", CS%wind_config, & "The character string that indicates how wind forcing is specified. Valid "//& "options include (file), (data_override), (2gyre), (1gyre), (gyres), (zero), "//& @@ -1738,17 +1749,17 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "With the gyres wind_config, the constant offset in the "//& "zonal wind stress profile: "//& " A in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + units="Pa", default=0.0, scale=US%Pa_to_RLZ_T2) call get_param(param_file, mdl, "TAUX_SIN_AMP", CS%gyres_taux_sin_amp, & "With the gyres wind_config, the sine amplitude in the "//& "zonal wind stress profile: "//& " B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + units="Pa", default=0.0, scale=US%Pa_to_RLZ_T2) call get_param(param_file, mdl, "TAUX_COS_AMP", CS%gyres_taux_cos_amp, & "With the gyres wind_config, the cosine amplitude in "//& "the zonal wind stress profile: "//& " C in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + units="Pa", default=0.0, scale=US%Pa_to_RLZ_T2) call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & "With the gyres wind_config, the number of gyres in "//& "the zonal wind stress profile: "//& @@ -1786,8 +1797,24 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "WIND_SCURVES_TAUX", CS%scurves_taux, & "A list of zonal wind stress values at latitudes "//& "WIND_SCURVES_LATS defining a piecewise scurve profile.", & - units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) + units="Pa", scale=US%Pa_to_RLZ_T2, fail_if_missing=.true.) + endif + if (trim(CS%wind_config) == "2gyre") then + call get_param(param_file, mdl, "TAUX_MAGNITUDE", CS%taux_mag, & + "The peak zonal wind stress when WIND_CONFIG = 2gyre.", & + units="Pa", default=0.1, scale=US%Pa_to_RLZ_T2) endif + if (trim(CS%wind_config) == "1gyre") then + call get_param(param_file, mdl, "TAUX_MAGNITUDE", CS%taux_mag, & + "The peak zonal wind stress when WIND_CONFIG = 1gyre.", & + units="Pa", default=-0.2, scale=US%Pa_to_RLZ_T2) + endif + if (trim(CS%wind_config) == "Neverworld" .or. trim(CS%wind_config) == "Neverland") then + call get_param(param_file, mdl, "TAUX_MAGNITUDE", CS%taux_mag, & + "The peak zonal wind stress when WIND_CONFIG = Neverworld.", & + units="Pa", default=0.2, scale=US%Pa_to_RLZ_T2) + endif + if ((trim(CS%wind_config) == "2gyre") .or. & (trim(CS%wind_config) == "1gyre") .or. & (trim(CS%wind_config) == "gyres") .or. & @@ -1855,7 +1882,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & - units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + units="Pa", default=0.0, scale=US%Pa_to_RLZ_T2) call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & "If true correct a bug in the time-averaging of the gustless wind friction velocity", & default=.true.) @@ -1871,7 +1898,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! NOTE: There are certain cases where FMS is unable to read this file, so ! we use read_netCDF_data in place of MOM_read_data. call read_netCDF_data(filename, 'gustiness', CS%gust, G%Domain, & - rescale=Pa_to_RLZ_T2) ! units in file should be Pa + rescale=US%Pa_to_RLZ_T2) ! units in file should be [Pa] endif ! All parameter settings are now known. @@ -1890,10 +1917,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C elseif (trim(CS%wind_config) == "const") then call get_param(param_file, mdl, "CONST_WIND_TAUX", CS%tau_x0, & "With wind_config const, this is the constant zonal wind-stress", & - units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) + units="Pa", scale=US%Pa_to_RLZ_T2, fail_if_missing=.true.) call get_param(param_file, mdl, "CONST_WIND_TAUY", CS%tau_y0, & "With wind_config const, this is the constant meridional wind-stress", & - units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) + units="Pa", scale=US%Pa_to_RLZ_T2, fail_if_missing=.true.) elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. & trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS%SCM_CVmix_tests_CSp) diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90 index fc803c27e6..d7d3b89a8a 100644 --- a/config_src/drivers/solo_driver/user_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/user_surface_forcing.F90 @@ -78,7 +78,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! calculation of ustar - otherwise the lower bound would be Isq. do j=js,je ; do I=is-1,Ieq ! Change this to the desired expression. - forces%taux(I,j) = G%mask2dCu(I,j) * 0.0*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + forces%taux(I,j) = G%mask2dCu(I,j) * 0.0*US%Pa_to_RLZ_T2 enddo ; enddo do J=js-1,Jeq ; do i=is,ie forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. @@ -88,9 +88,10 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt((CS%gust_const + & + forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gust_const + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))) * (US%L_to_Z/CS%Rho0)) + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))) + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(forces%tau_mag(i,j) * (US%L_to_Z/CS%Rho0)) enddo ; enddo ; endif end subroutine USER_wind_forcing @@ -271,7 +272,7 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & - units="Pa", default=0.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) + units="Pa", default=0.0, scale=US%Pa_to_RLZ_T2) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& diff --git a/config_src/infra/FMS1/MOM_coms_infra.F90 b/config_src/infra/FMS1/MOM_coms_infra.F90 index 939161875e..13f8006184 100644 --- a/config_src/infra/FMS1/MOM_coms_infra.F90 +++ b/config_src/infra/FMS1/MOM_coms_infra.F90 @@ -25,7 +25,7 @@ module MOM_coms_infra !> Communicate an array, string or scalar from one PE to others interface broadcast module procedure broadcast_char, broadcast_int32_0D, broadcast_int64_0D, broadcast_int1D - module procedure broadcast_real0D, broadcast_real1D, broadcast_real2D + module procedure broadcast_real0D, broadcast_real1D, broadcast_real2D, broadcast_real3D end interface broadcast !> Compute a checksum for a field distributed over a PE list. If no PE list is @@ -260,6 +260,28 @@ subroutine broadcast_real2D(dat, length, from_PE, PElist, blocking) end subroutine broadcast_real2D + +!> Communicate a 3-D array of reals from one PE to others +subroutine broadcast_real3D(dat, length, from_PE, PElist, blocking) + real, dimension(:,:,:), intent(inout) :: dat !< The data to communicate and destination + integer, intent(in) :: length !< The total number of data elements + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, length, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_real3D + ! field_chksum wrappers !> Compute a checksum for a field distributed over a PE list. If no PE list is diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index 470dde0848..2c97a0bb31 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -24,6 +24,8 @@ module MOM_domain_infra use mpp_domains_mod, only : To_North => SUPDATE, To_South => NUPDATE use mpp_domains_mod, only : CENTER, CORNER, NORTH_FACE => NORTH, EAST_FACE => EAST use fms_io_mod, only : file_exist, parse_mask_table +use fms_io_mod, only : fms_set_domain => set_domain +use fms_io_mod, only : fms_nullify_domain => nullify_domain use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set, fms_affinity_get ! This subroutine is not in MOM6/src but may be required by legacy drivers @@ -49,6 +51,7 @@ module MOM_domain_infra public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR public :: CORNER, CENTER, NORTH_FACE, EAST_FACE +public :: set_domain, nullify_domain ! These are no longer used by MOM6 because the reproducing sum works so well, but they are ! still referenced by some of the non-GFDL couplers. ! public :: global_field_sum, BITWISE_EXACT_SUM @@ -1489,7 +1492,7 @@ end subroutine get_domain_components_d2D !> clone_MD_to_MD copies one MOM_domain_type into another, while allowing !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain_name, & - turns, refine, extra_halo) + turns, refine, extra_halo, io_layout) type(MOM_domain_type), target, intent(in) :: MD_in !< An existing MOM_domain type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be @@ -1512,6 +1515,8 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain integer, optional, intent(in) :: refine !< A factor by which to enhance the grid resolution. integer, optional, intent(in) :: extra_halo !< An extra number of points in the halos !! compared with MD_in + integer, optional, intent(in) :: io_layout(2) + !< A user-defined IO layout to replace the domain's IO layout logical :: mask_table_exists integer, dimension(:), allocatable :: exni ! The extents of the grid for each i-row of the layout. @@ -1520,10 +1525,17 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain ! The sum of exni must equal MOM_dom%niglobal. integer :: qturns ! The number of quarter turns, restricted to the range of 0 to 3. integer :: i, j, nl1, nl2 + integer :: io_layout_in(2) qturns = 0 if (present(turns)) qturns = modulo(turns, 4) + if (present(io_layout)) then + io_layout_in(:) = io_layout(:) + else + io_layout_in(:) = MD_in%io_layout(:) + endif + if (.not.associated(MOM_dom)) then allocate(MOM_dom) allocate(MOM_dom%mpp_domain) @@ -1542,7 +1554,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%X_FLAGS = MD_in%Y_FLAGS ; MOM_dom%Y_FLAGS = MD_in%X_FLAGS MOM_dom%layout(:) = MD_in%layout(2:1:-1) - MOM_dom%io_layout(:) = MD_in%io_layout(2:1:-1) + MOM_dom%io_layout(:) = io_layout_in(2:1:-1) else MOM_dom%niglobal = MD_in%niglobal ; MOM_dom%njglobal = MD_in%njglobal MOM_dom%nihalo = MD_in%nihalo ; MOM_dom%njhalo = MD_in%njhalo @@ -1550,7 +1562,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS MOM_dom%layout(:) = MD_in%layout(:) - MOM_dom%io_layout(:) = MD_in%io_layout(:) + MOM_dom%io_layout(:) = io_layout_in(:) endif ! Ensure that the points per processor are the same on the source and densitation grids. @@ -1989,4 +2001,17 @@ subroutine get_layout_extents(Domain, extent_i, extent_j) call mpp_get_domain_extents(domain%mpp_domain, extent_i, extent_j) end subroutine get_layout_extents +!> Set the associated domain for internal FMS I/O operations. +subroutine set_domain(Domain) + type(MOM_domain_type), intent(in) :: Domain + !< MOM domain to be designated as the internal FMS I/O domain + + call fms_set_domain(Domain%mpp_domain) +end subroutine set_domain + +!> Free the associated domain for internal FMS I/O operations. +subroutine nullify_domain + call fms_nullify_domain +end subroutine nullify_domain + end module MOM_domain_infra diff --git a/config_src/infra/FMS1/MOM_interp_infra.F90 b/config_src/infra/FMS1/MOM_interp_infra.F90 index 224e26a051..70bc99827e 100644 --- a/config_src/infra/FMS1/MOM_interp_infra.F90 +++ b/config_src/infra/FMS1/MOM_interp_infra.F90 @@ -4,9 +4,11 @@ module MOM_interp_infra ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domain_infra, only : MOM_domain_type, domain2d +use MOM_io, only : axis_info +use MOM_io, only : set_axis_info use MOM_time_manager, only : time_type use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_init, horiz_interp_type -use mpp_io_mod, only : axistype, mpp_get_axis_data +use mpp_io_mod, only : axistype, mpp_get_axis_data, mpp_get_atts use time_interp_external_mod, only : time_interp_external use time_interp_external_mod, only : init_external_field, time_interp_external_init use time_interp_external_mod, only : get_external_field_size @@ -18,6 +20,18 @@ module MOM_interp_infra public :: time_interp_extern, init_extern_field, time_interp_extern_init public :: get_external_field_info, axistype, get_axis_data public :: run_horiz_interp, build_horiz_interp_weights +public :: external_field + +!< Handle of an external field for interpolation +type :: external_field + private + integer :: id + !< FMS ID for the interpolated field + character(len=:), allocatable :: filename + !< Filename containing the field values + character(len=:), allocatable :: label + !< Field name in the file +end type external_field !> Read a field based on model time, and rotate to the model domain. interface time_interp_extern @@ -145,13 +159,33 @@ end function get_extern_field_size !> get axes of an external field from field index -function get_extern_field_axes(index) +function get_extern_field_axes(index) result(axes) - integer, intent(in) :: index !< field index - type(axistype), dimension(4) :: get_extern_field_axes !< field axes + integer, intent(in) :: index !< FMS interpolation field index + type(axis_info) :: axes(4) !< MOM IO field axes handle - get_extern_field_axes = get_external_field_axes(index) + type(axistype), dimension(4) :: fms_axes(4) + ! FMS axis handles + character(len=32) :: name + ! Axis name + real, allocatable :: points(:) + ! Axis line points + integer :: length + ! Axis line point length + integer :: i + ! Loop index + fms_axes = get_external_field_axes(index) + + do i = 1, 4 + call mpp_get_atts(fms_axes(i), name=name, len=length) + + allocate(points(length)) + call mpp_get_axis_data(fms_axes(i), points) + call set_axis_info(axes(i), name=name, ax_data=points) + + deallocate(points) + enddo end function get_extern_field_axes @@ -167,46 +201,44 @@ end function get_extern_field_missing !> Get information about the external fields. -subroutine get_external_field_info(field_id, size, axes, missing) - integer, intent(in) :: field_id !< The integer index of the external - !! field returned from a previous - !! call to init_external_field() - integer, dimension(4), optional, intent(inout) :: size !< Dimension sizes for the input data - type(axistype), dimension(4), optional, intent(inout) :: axes !< Axis types for the input data - real, optional, intent(inout) :: missing !< Missing value for the input data +subroutine get_external_field_info(field, size, axes, missing) + type(external_field), intent(in) :: field !< Handle for time interpolated external + !! field returned from a previous + !! call to init_external_field() + integer, optional, intent(inout) :: size(4) !< Dimension sizes for the input data + type(axis_info), optional, intent(inout) :: axes(4) !< Axis types for the input data + real, optional, intent(inout) :: missing !< Missing value for the input data if (present(size)) then - size(1:4) = get_extern_field_size(field_id) + size(1:4) = get_extern_field_size(field%id) endif if (present(axes)) then - axes(1:4) = get_extern_field_axes(field_id) + axes(1:4) = get_extern_field_axes(field%id) endif if (present(missing)) then - missing = get_extern_field_missing(field_id) + missing = get_extern_field_missing(field%id) endif end subroutine get_external_field_info !> Read a scalar field based on model time. -subroutine time_interp_extern_0d(field_id, time, data_in, verbose) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_extern_0d(field, time, data_in, verbose) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, intent(inout) :: data_in !< The interpolated value logical, optional, intent(in) :: verbose !< If true, write verbose output for debugging - call time_interp_external(field_id, time, data_in, verbose=verbose) + call time_interp_external(field%id, time, data_in, verbose=verbose) end subroutine time_interp_extern_0d !> Read a 2d field from an external based on model time, potentially including horizontal !! interpolation and rotation of the data -subroutine time_interp_extern_2d(field_id, time, data_in, interp, verbose, horz_interp, mask_out) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_extern_2d(field, time, data_in, interp, verbose, horz_interp, mask_out) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, dimension(:,:), intent(inout) :: data_in !< The array in which to store the interpolated values integer, optional, intent(in) :: interp !< A flag indicating the temporal interpolation method @@ -216,15 +248,14 @@ subroutine time_interp_extern_2d(field_id, time, data_in, interp, verbose, horz_ logical, dimension(:,:), & optional, intent(out) :: mask_out !< An array that is true where there is valid data - call time_interp_external(field_id, time, data_in, interp=interp, verbose=verbose, & + call time_interp_external(field%id, time, data_in, interp=interp, verbose=verbose, & horz_interp=horz_interp, mask_out=mask_out) end subroutine time_interp_extern_2d !> Read a 3d field based on model time, and rotate to the model grid -subroutine time_interp_extern_3d(field_id, time, data_in, interp, verbose, horz_interp, mask_out) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_extern_3d(field, time, data_in, interp, verbose, horz_interp, mask_out) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, dimension(:,:,:), intent(inout) :: data_in !< The array in which to store the interpolated values integer, optional, intent(in) :: interp !< A flag indicating the temporal interpolation method @@ -234,14 +265,15 @@ subroutine time_interp_extern_3d(field_id, time, data_in, interp, verbose, horz_ logical, dimension(:,:,:), & optional, intent(out) :: mask_out !< An array that is true where there is valid data - call time_interp_external(field_id, time, data_in, interp=interp, verbose=verbose, & + call time_interp_external(field%id, time, data_in, interp=interp, verbose=verbose, & horz_interp=horz_interp, mask_out=mask_out) end subroutine time_interp_extern_3d !> initialize an external field -integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & - threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency ) +function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & + threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency) & + result(field) character(len=*), intent(in) :: file !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -261,17 +293,17 @@ integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, !! is in use, and (2) the modulo time period of the !! data is an integer number of years, then map !! a model date of Feb 29. onto a common year on Feb. 28. + type(external_field) :: field !< Handle to external field if (present(MOM_Domain)) then - init_extern_field = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & + field%id = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & correct_leap_year_inconsistency=correct_leap_year_inconsistency) else - init_extern_field = init_external_field(file, fieldname, domain=domain, & + field%id = init_external_field(file, fieldname, domain=domain, & verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & correct_leap_year_inconsistency=correct_leap_year_inconsistency) endif - end function init_extern_field end module MOM_interp_infra diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index c0ccfcbcc8..e37e5db3cb 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -57,7 +57,7 @@ module MOM_io_infra !> Read a data field from a file interface read_field module procedure read_field_4d - module procedure read_field_3d + module procedure read_field_3d, read_field_3d_region module procedure read_field_2d, read_field_2d_region module procedure read_field_1d, read_field_1d_int module procedure read_field_0d, read_field_0d_int @@ -696,6 +696,45 @@ subroutine read_field_3d(filename, fieldname, data, MOM_Domain, & endif ; endif end subroutine read_field_3d +!> This routine uses the fms_io subroutine read_data to read a region from a distributed or +!! global 3-D data field named "fieldname" from file "filename". +subroutine read_field_3d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale) + character(len=*), intent(in) :: filename !< The name of the file to read + character(len=*), intent(in) :: fieldname !< The variable name of the data in the file + real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data + !! should be read + integer, dimension(:), intent(in) :: start !< The starting index to read in each of 4 + !! dimensions. For this 3-d read, the + !! 4th values are always 1. + integer, dimension(:), intent(in) :: nread !< The number of points to read in each of 4 + !! dimensions. For this 3-d read, the + !! 4th values are always 1. + type(MOM_domain_type), & + optional, intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition + logical, optional, intent(in) :: no_domain !< If present and true, this variable does not + !! use domain decomposion. + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before it is returned. + + if (present(MOM_Domain)) then + call read_data(filename, fieldname, data, start, nread, domain=MOM_Domain%mpp_domain, & + no_domain=no_domain) + else + call read_data(filename, fieldname, data, start, nread, no_domain=no_domain) + endif + + if (present(scale)) then ; if (scale /= 1.0) then + if (present(MOM_Domain)) then + call rescale_comp_data(MOM_Domain, data, scale) + else + ! Dangerously rescale the whole array + data(:,:,:) = scale*data(:,:,:) + endif + endif ; endif +end subroutine read_field_3d_region + + !> This routine uses the fms_io subroutine read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. diff --git a/config_src/infra/FMS2/MOM_coms_infra.F90 b/config_src/infra/FMS2/MOM_coms_infra.F90 index 939161875e..cf9a724734 100644 --- a/config_src/infra/FMS2/MOM_coms_infra.F90 +++ b/config_src/infra/FMS2/MOM_coms_infra.F90 @@ -25,7 +25,7 @@ module MOM_coms_infra !> Communicate an array, string or scalar from one PE to others interface broadcast module procedure broadcast_char, broadcast_int32_0D, broadcast_int64_0D, broadcast_int1D - module procedure broadcast_real0D, broadcast_real1D, broadcast_real2D + module procedure broadcast_real0D, broadcast_real1D, broadcast_real2D, broadcast_real3D end interface broadcast !> Compute a checksum for a field distributed over a PE list. If no PE list is @@ -260,6 +260,27 @@ subroutine broadcast_real2D(dat, length, from_PE, PElist, blocking) end subroutine broadcast_real2D +!> Communicate a 3-D array of reals from one PE to others +subroutine broadcast_real3D(dat, length, from_PE, PElist, blocking) + real, dimension(:,:,:), intent(inout) :: dat !< The data to communicate and destination + integer, intent(in) :: length !< The total number of data elements + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, length, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_real3D + ! field_chksum wrappers !> Compute a checksum for a field distributed over a PE list. If no PE list is diff --git a/config_src/infra/FMS2/MOM_domain_infra.F90 b/config_src/infra/FMS2/MOM_domain_infra.F90 index d845d7317b..ff1d888c47 100644 --- a/config_src/infra/FMS2/MOM_domain_infra.F90 +++ b/config_src/infra/FMS2/MOM_domain_infra.F90 @@ -23,7 +23,7 @@ module MOM_domain_infra use mpp_domains_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE use mpp_domains_mod, only : To_North => SUPDATE, To_South => NUPDATE use mpp_domains_mod, only : CENTER, CORNER, NORTH_FACE => NORTH, EAST_FACE => EAST -use fms_io_mod, only : file_exist, parse_mask_table +use fms_io_utils_mod, only : file_exists, parse_mask_table use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set, fms_affinity_get ! This subroutine is not in MOM6/src but may be required by legacy drivers @@ -49,6 +49,7 @@ module MOM_domain_infra public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR public :: CORNER, CENTER, NORTH_FACE, EAST_FACE +public :: set_domain, nullify_domain ! These are no longer used by MOM6 because the reproducing sum works so well, but they are ! still referenced by some of the non-GFDL couplers. ! public :: global_field_sum, BITWISE_EXACT_SUM @@ -1390,7 +1391,7 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l endif if (present(mask_table)) then - mask_table_exists = file_exist(mask_table) + mask_table_exists = file_exists(mask_table) if (mask_table_exists) then allocate(MOM_dom%maskmap(layout(1), layout(2))) call parse_mask_table(mask_table, MOM_dom%maskmap, MOM_dom%name) @@ -1491,7 +1492,7 @@ end subroutine get_domain_components_d2D !> clone_MD_to_MD copies one MOM_domain_type into another, while allowing !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain_name, & - turns, refine, extra_halo) + turns, refine, extra_halo, io_layout) type(MOM_domain_type), target, intent(in) :: MD_in !< An existing MOM_domain type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be @@ -1514,6 +1515,9 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain integer, optional, intent(in) :: refine !< A factor by which to enhance the grid resolution. integer, optional, intent(in) :: extra_halo !< An extra number of points in the halos !! compared with MD_in + integer, optional, intent(in) :: io_layout(2) + !< A user-defined IO layout to replace the domain's IO layout + integer :: global_indices(4) logical :: mask_table_exists @@ -1523,10 +1527,17 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain ! The sum of exni must equal MOM_dom%niglobal. integer :: qturns ! The number of quarter turns, restricted to the range of 0 to 3. integer :: i, j, nl1, nl2 + integer :: io_layout_in(2) qturns = 0 if (present(turns)) qturns = modulo(turns, 4) + if (present(io_layout)) then + io_layout_in(:) = io_layout(:) + else + io_layout_in(:) = MD_in%io_layout(:) + endif + if (.not.associated(MOM_dom)) then allocate(MOM_dom) allocate(MOM_dom%mpp_domain) @@ -1545,7 +1556,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%X_FLAGS = MD_in%Y_FLAGS ; MOM_dom%Y_FLAGS = MD_in%X_FLAGS MOM_dom%layout(:) = MD_in%layout(2:1:-1) - MOM_dom%io_layout(:) = MD_in%io_layout(2:1:-1) + MOM_dom%io_layout(:) = io_layout_in(2:1:-1) else MOM_dom%niglobal = MD_in%niglobal ; MOM_dom%njglobal = MD_in%njglobal MOM_dom%nihalo = MD_in%nihalo ; MOM_dom%njhalo = MD_in%njhalo @@ -1553,7 +1564,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS MOM_dom%layout(:) = MD_in%layout(:) - MOM_dom%io_layout(:) = MD_in%io_layout(:) + MOM_dom%io_layout(:) = io_layout_in(:) endif ! Ensure that the points per processor are the same on the source and densitation grids. @@ -1992,4 +2003,17 @@ subroutine get_layout_extents(Domain, extent_i, extent_j) call mpp_get_domain_extents(domain%mpp_domain, extent_i, extent_j) end subroutine get_layout_extents +!> Set the associated domain for internal FMS I/O operations. +subroutine set_domain(Domain) + type(MOM_domain_type), intent(in) :: Domain + !< MOM domain to be designated as the internal FMS I/O domain + + ! FMS2 does not have domain-based internal FMS I/O operations, so this + ! function does nothing. +end subroutine set_domain + +subroutine nullify_domain + ! No internal FMS I/O domain can be assigned, so this function does nothing. +end subroutine nullify_domain + end module MOM_domain_infra diff --git a/config_src/infra/FMS2/MOM_interp_infra.F90 b/config_src/infra/FMS2/MOM_interp_infra.F90 index c29459aad1..0b45b752ae 100644 --- a/config_src/infra/FMS2/MOM_interp_infra.F90 +++ b/config_src/infra/FMS2/MOM_interp_infra.F90 @@ -4,20 +4,37 @@ module MOM_interp_infra ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domain_infra, only : MOM_domain_type, domain2d +use MOM_io, only : axis_info +use MOM_io, only : get_var_axes_info use MOM_time_manager, only : time_type -use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_init, horiz_interp_type -use mpp_io_mod, only : axistype, mpp_get_axis_data -use time_interp_external_mod, only : time_interp_external -use time_interp_external_mod, only : init_external_field, time_interp_external_init -use time_interp_external_mod, only : get_external_field_size -use time_interp_external_mod, only : get_external_field_axes, get_external_field_missing +use MOM_error_handler, only : MOM_error, FATAL +use MOM_string_functions, only : lowercase +use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_init, horiz_interp_type +use netcdf_io_mod, only : FmsNetcdfFile_t, netcdf_file_open, netcdf_file_close +use netcdf_io_mod, only : get_num_variables, get_variable_names +use time_interp_external2_mod, only : time_interp_external +use time_interp_external2_mod, only : init_external_field, time_interp_external_init +use time_interp_external2_mod, only : get_external_field_size +use time_interp_external2_mod, only : get_external_field_missing implicit none ; private public :: horiz_interp_type, horizontal_interp_init public :: time_interp_extern, init_extern_field, time_interp_extern_init -public :: get_external_field_info, axistype, get_axis_data +public :: get_external_field_info public :: run_horiz_interp, build_horiz_interp_weights +public :: external_field + +!< Handle of an external field for interpolation +type :: external_field + private + integer :: id + !< FMS ID for the interpolated field + character(len=:), allocatable :: filename + !< Filename containing the field values + character(len=:), allocatable :: label + !< Field name in the file +end type external_field !> Read a field based on model time, and rotate to the model domain. interface time_interp_extern @@ -123,15 +140,6 @@ subroutine build_horiz_interp_weights_2d_to_2d(Interp, lon_in, lat_in, lon_out, end subroutine build_horiz_interp_weights_2d_to_2d -!> Extracts and returns the axis data stored in an axistype. -subroutine get_axis_data( axis, dat ) - type(axistype), intent(in) :: axis !< An axis type - real, dimension(:), intent(out) :: dat !< The data in the axis variable - - call mpp_get_axis_data( axis, dat ) -end subroutine get_axis_data - - !> get size of an external field from field index function get_extern_field_size(index) @@ -144,13 +152,11 @@ end function get_extern_field_size !> get axes of an external field from field index -function get_extern_field_axes(index) - - integer, intent(in) :: index !< field index - type(axistype), dimension(4) :: get_extern_field_axes !< field axes - - get_extern_field_axes = get_external_field_axes(index) +function get_extern_field_axes(field) result(axes) + type(external_field), intent(in) :: field !< Field handle + type(axis_info), dimension(4) :: axes !< Field axes + call get_var_axes_info(field%filename, field%label, axes) end function get_extern_field_axes @@ -166,46 +172,44 @@ end function get_extern_field_missing !> Get information about the external fields. -subroutine get_external_field_info(field_id, size, axes, missing) - integer, intent(in) :: field_id !< The integer index of the external +subroutine get_external_field_info(field, size, axes, missing) + type(external_field), intent(in) :: field !< Handle for time interpolated external !! field returned from a previous !! call to init_external_field() - integer, dimension(4), optional, intent(inout) :: size !< Dimension sizes for the input data - type(axistype), dimension(4), optional, intent(inout) :: axes !< Axis types for the input data - real, optional, intent(inout) :: missing !< Missing value for the input data + integer, dimension(4), optional, intent(inout) :: size !< Dimension sizes for the input data + type(axis_info), dimension(4), optional, intent(inout) :: axes !< Axis types for the input data + real, optional, intent(inout) :: missing !< Missing value for the input data if (present(size)) then - size(1:4) = get_extern_field_size(field_id) + size(1:4) = get_extern_field_size(field%id) endif if (present(axes)) then - axes(1:4) = get_extern_field_axes(field_id) + axes(1:4) = get_extern_field_axes(field) endif if (present(missing)) then - missing = get_extern_field_missing(field_id) + missing = get_extern_field_missing(field%id) endif end subroutine get_external_field_info !> Read a scalar field based on model time. -subroutine time_interp_extern_0d(field_id, time, data_in, verbose) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_extern_0d(field, time, data_in, verbose) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, intent(inout) :: data_in !< The interpolated value logical, optional, intent(in) :: verbose !< If true, write verbose output for debugging - call time_interp_external(field_id, time, data_in, verbose=verbose) + call time_interp_external(field%id, time, data_in, verbose=verbose) end subroutine time_interp_extern_0d !> Read a 2d field from an external based on model time, potentially including horizontal !! interpolation and rotation of the data -subroutine time_interp_extern_2d(field_id, time, data_in, interp, verbose, horz_interp, mask_out) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_extern_2d(field, time, data_in, interp, verbose, horz_interp, mask_out) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, dimension(:,:), intent(inout) :: data_in !< The array in which to store the interpolated values integer, optional, intent(in) :: interp !< A flag indicating the temporal interpolation method @@ -215,15 +219,14 @@ subroutine time_interp_extern_2d(field_id, time, data_in, interp, verbose, horz_ logical, dimension(:,:), & optional, intent(out) :: mask_out !< An array that is true where there is valid data - call time_interp_external(field_id, time, data_in, interp=interp, verbose=verbose, & + call time_interp_external(field%id, time, data_in, interp=interp, verbose=verbose, & horz_interp=horz_interp, mask_out=mask_out) end subroutine time_interp_extern_2d !> Read a 3d field based on model time, and rotate to the model grid -subroutine time_interp_extern_3d(field_id, time, data_in, interp, verbose, horz_interp, mask_out) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_extern_3d(field, time, data_in, interp, verbose, horz_interp, mask_out) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, dimension(:,:,:), intent(inout) :: data_in !< The array in which to store the interpolated values integer, optional, intent(in) :: interp !< A flag indicating the temporal interpolation method @@ -233,14 +236,15 @@ subroutine time_interp_extern_3d(field_id, time, data_in, interp, verbose, horz_ logical, dimension(:,:,:), & optional, intent(out) :: mask_out !< An array that is true where there is valid data - call time_interp_external(field_id, time, data_in, interp=interp, verbose=verbose, & + call time_interp_external(field%id, time, data_in, interp=interp, verbose=verbose, & horz_interp=horz_interp, mask_out=mask_out) end subroutine time_interp_extern_3d !> initialize an external field -integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & - threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency ) +function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & + threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency) & + result(field) character(len=*), intent(in) :: file !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -260,19 +264,70 @@ integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, !! is in use, and (2) the modulo time period of the !! data is an integer number of years, then map !! a model date of Feb 29. onto a common year on Feb. 28. + type(external_field) :: field !< Handle to external field + + type(FmsNetcdfFile_t) :: extern_file + ! Local instance of netCDF file used to locate case-insensitive field name + integer :: num_fields + ! Number of fields in external file + character(len=256), allocatable :: extern_fieldnames(:) + ! List of field names in file + ! NOTE: length should NF90_MAX_NAME, but I don't know how to read it + character(len=:), allocatable :: label + ! Case-insensitive match to fieldname in file + logical :: rc + ! Return status + integer :: i + ! Loop index + + field%filename = file + + ! FMS2's init_external_field is case sensitive, so we must replicate the + ! case-insensitivity of FMS1. This requires opening the file twice. + + rc = netcdf_file_open(extern_file, file, 'read') + if (.not. rc) then + call MOM_error(FATAL, 'init_extern_file: file ' // trim(file) & + // ' could not be opened.') + endif + + ! TODO: broadcast = .false.? + num_fields = get_num_variables(extern_file) + allocate(extern_fieldnames(num_fields)) + call get_variable_names(extern_file, extern_fieldnames) + do i = 1, num_fields + if (lowercase(extern_fieldnames(i)) == lowercase(fieldname)) then + field%label = extern_fieldnames(i) + exit + endif + enddo + + call netcdf_file_close(extern_file) + + if (.not. allocated(field%label)) then + call MOM_error(FATAL, 'init_extern_field: field ' // trim(fieldname) & + // ' not found in ' // trim(file) // '.') + endif + + ! Pass to FMS2 implementation of init_external_field + + ! NOTE: external fields are currently assumed to be on-grid, which holds + ! across the current codebase. In the future, we may need to either enforce + ! this or somehow relax this requirement. if (present(MOM_Domain)) then - init_extern_field = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & - correct_leap_year_inconsistency=correct_leap_year_inconsistency) + field%id = init_external_field(file, field%label, domain=MOM_domain%mpp_domain, & + verbose=verbose, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency, & + ongrid=.true.) else - init_extern_field = init_external_field(file, fieldname, domain=domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & - correct_leap_year_inconsistency=correct_leap_year_inconsistency) + field%id = init_external_field(file, field%label, domain=domain, & + verbose=verbose, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency, & + ongrid=.true.) endif - end function init_extern_field end module MOM_interp_infra diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 54b9dfb78b..a43b4e9344 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -9,6 +9,7 @@ module MOM_io_infra use MOM_string_functions, only : lowercase use fms2_io_mod, only : fms2_open_file => open_file, check_if_open, fms2_close_file => close_file +use fms2_io_mod, only : fms2_flush_file => flush_file use fms2_io_mod, only : FmsNetcdfDomainFile_t, FmsNetcdfFile_t, fms2_read_data => read_data use fms2_io_mod, only : get_unlimited_dimension_name, get_num_dimensions, get_num_variables use fms2_io_mod, only : get_variable_names, variable_exists, get_variable_size, get_variable_units @@ -16,32 +17,31 @@ module MOM_io_infra use fms2_io_mod, only : variable_att_exists, get_variable_attribute, get_variable_num_dimensions use fms2_io_mod, only : get_variable_dimension_names, is_dimension_registered, get_dimension_size use fms2_io_mod, only : is_dimension_unlimited, register_axis, unlimited +use fms2_io_mod, only : get_dimension_names use fms2_io_mod, only : get_global_io_domain_indices use fms_io_utils_mod, only : fms2_file_exist => file_exists +use fms_io_utils_mod, only : get_filename_appendix use fms_mod, only : write_version_number, check_nml_error -use fms_io_mod, only : file_exist, field_exist, field_size, read_data -use fms_io_mod, only : fms_io_exit, get_filename_appendix use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_global_domain -use mpp_io_mod, only : mpp_open, mpp_close, mpp_flush -use mpp_io_mod, only : mpp_write_meta, mpp_write -use mpp_io_mod, only : mpp_get_atts, mpp_attribute_exist -use mpp_io_mod, only : mpp_get_axes, mpp_axistype=>axistype, mpp_get_axis_data -use mpp_io_mod, only : mpp_get_fields, mpp_fieldtype=>fieldtype -use mpp_io_mod, only : mpp_get_info, mpp_get_times -use mpp_io_mod, only : mpp_io_init use mpp_mod, only : stdout_if_root=>stdout use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_npes use mpp_mod, only : mpp_get_current_pelist_name -! These are encoding constants. -use mpp_io_mod, only : APPEND_FILE=>MPP_APPEND, WRITEONLY_FILE=>MPP_WRONLY -use mpp_io_mod, only : OVERWRITE_FILE=>MPP_OVERWR, READONLY_FILE=>MPP_RDONLY -use mpp_io_mod, only : NETCDF_FILE=>MPP_NETCDF, ASCII_FILE=>MPP_ASCII -use mpp_io_mod, only : MULTIPLE=>MPP_MULTI, SINGLE_FILE=>MPP_SINGLE use iso_fortran_env, only : int64 implicit none ; private +! Duplication of FMS1 parameter values +! NOTE: Only kept to emulate FMS1 behavior, and may be removed in the future. +integer, parameter :: WRITEONLY_FILE = 100 +integer, parameter :: READONLY_FILE = 101 +integer, parameter :: APPEND_FILE = 102 +integer, parameter :: OVERWRITE_FILE = 103 +integer, parameter :: ASCII_FILE = 200 +integer, parameter :: NETCDF_FILE = 203 +integer, parameter :: SINGLE_FILE = 400 +integer, parameter :: MULTIPLE = 401 + ! These interfaces are actually implemented or have explicit interfaces in this file. public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix @@ -63,15 +63,10 @@ module MOM_io_infra module procedure MOM_file_exists end interface -!> Open a file (or fileset) for parallel or single-file I/O. -interface open_file - module procedure open_file_type, open_file_unit -end interface open_file - !> Read a data field from a file interface read_field module procedure read_field_4d - module procedure read_field_3d + module procedure read_field_3d, read_field_3d_region module procedure read_field_2d, read_field_2d_region module procedure read_field_1d, read_field_1d_int module procedure read_field_0d, read_field_0d_int @@ -104,11 +99,6 @@ module MOM_io_infra module procedure close_file_type, close_file_unit end interface close_file -!> Ensure that the output stream associated with a file handle is fully sent to disk -interface flush_file - module procedure flush_file_type, flush_file_unit -end interface flush_file - !> Type for holding a handle to an open file and related information type :: file_type ; private integer :: unit = -1 !< The framework identfier or netCDF unit number of an output file @@ -119,32 +109,24 @@ module MOM_io_infra logical :: open_to_write = .false. !< If true, this file or fileset can be written to integer :: num_times !< The number of time levels in this file real :: file_time !< The time of the latest entry in the file. - logical :: FMS2_file !< If true, this file-type is to be used with FMS2 interfaces. end type file_type !> This type is a container for information about a variable in a file. type :: fieldtype ; private character(len=256) :: name !< The name of this field in the files. - type(mpp_fieldtype) :: FT !< The FMS1 field-type that this type wraps character(len=:), allocatable :: longname !< The long name for this field character(len=:), allocatable :: units !< The units for this field integer(kind=int64) :: chksum_read !< A checksum that has been read from a file logical :: valid_chksum !< If true, this field has a valid checksum value. - logical :: FMS2_field !< If true, this field-type should be used with FMS2 interfaces. end type fieldtype !> This type is a container for information about an axis in a file. type :: axistype ; private character(len=256) :: name !< The name of this axis in the files. - type(mpp_axistype) :: AT !< The FMS1 axis-type that this type wraps real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis. logical :: domain_decomposed = .false. !< True if axis is domain-decomposed end type axistype -!> For now, these module-variables are hard-coded to exercise the new FMS2 interfaces. -logical :: FMS2_reads = .true. -logical :: FMS2_writes = .true. - contains !> Reads the checksum value for a field that was recorded in a file, along with a flag indicating @@ -165,11 +147,10 @@ logical function MOM_file_exists(filename, MOM_Domain) character(len=*), intent(in) :: filename !< The name of the file being inquired about type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition -! This function uses the fms_io function file_exist to determine whether -! a named file (or its decomposed variant) exists. - - MOM_file_exists = file_exist(filename, MOM_Domain%mpp_domain) + type(FmsNetcdfDomainFile_t) :: fileobj + MOM_file_exists = fms2_open_file(fileobj, filename, "read", MOM_Domain%mpp_domain) + if (MOM_file_exists) call fms2_close_file(fileobj) end function MOM_file_exists !> Returns true if the named file or its domain-decomposed variant exists. @@ -196,15 +177,16 @@ subroutine close_file_type(IO_handle) if (associated(IO_handle%fileobj)) then call fms2_close_file(IO_handle%fileobj) deallocate(IO_handle%fileobj) - else - call mpp_close(IO_handle%unit) endif if (allocated(IO_handle%filename)) deallocate(IO_handle%filename) IO_handle%open_to_read = .false. ; IO_handle%open_to_write = .false. IO_handle%num_times = 0 ; IO_handle%file_time = 0.0 - IO_handle%FMS2_file = .false. end subroutine close_file_type +! TODO: close_file_unit is only used for ASCII files, which are opened outside +! of the framework, so this could probably be removed, and those calls could +! just be replaced with close(unit). + !> closes a file. If the unit does not point to an open file, !! close_file_unit simply returns without doing anything. subroutine close_file_unit(iounit) @@ -212,45 +194,30 @@ subroutine close_file_unit(iounit) logical :: unit_is_open - ! NOTE: Files opened by `mpp_open` must be closed by `mpp_close`. Otherwise, - ! an error will occur during `fms_io_exit`. - ! - ! Since there is no way to check if `fms_io_init` was called, we are forced - ! to visually confirm that the input unit was not created by `mpp_open`. - ! - ! After `mpp_open` has been removed, this message can be deleted. inquire(iounit, opened=unit_is_open) if (unit_is_open) close(iounit) end subroutine close_file_unit !> Ensure that the output stream associated with a file handle is fully sent to disk. -subroutine flush_file_type(IO_handle) +subroutine flush_file(IO_handle) type(file_type), intent(in) :: IO_handle !< The I/O handle for the file to flush if (associated(IO_handle%fileobj)) then - ! There does not appear to be an fms2 flush call. - else - call mpp_flush(IO_handle%unit) + call fms2_flush_file(IO_handle%fileobj) endif -end subroutine flush_file_type - -!> Ensure that the output stream associated with a unit is fully sent to disk. -subroutine flush_file_unit(unit) - integer, intent(in) :: unit !< The I/O unit for the file to flush - - call mpp_flush(unit) -end subroutine flush_file_unit +end subroutine flush_file !> Initialize the underlying I/O infrastructure subroutine io_infra_init(maxunits) integer, optional, intent(in) :: maxunits !< An optional maximum number of file !! unit numbers that can be used. - call mpp_io_init(maxunit=maxunits) + + ! FMS2 requires no explicit initialization, so this is a null function. end subroutine io_infra_init !> Gracefully close out and terminate the underlying I/O infrastructure subroutine io_infra_end() - call fms_io_exit() + ! FMS2 requires no explicit finalization, so this is a null function. end subroutine io_infra_end !> Open a single namelist file that is potentially readable by all PEs. @@ -299,35 +266,7 @@ subroutine write_version(version, tag, unit) end subroutine write_version !> open_file opens a file for parallel or single-file I/O. -subroutine open_file_unit(unit, filename, action, form, threading, fileset, nohdrs, domain, MOM_domain) - integer, intent(out) :: unit !< The I/O unit for the opened file - character(len=*), intent(in) :: filename !< The name of the file being opened - integer, optional, intent(in) :: action !< A flag indicating whether the file can be read - !! or written to and how to handle existing files. - integer, optional, intent(in) :: form !< A flag indicating the format of a new file. The - !! default is ASCII_FILE, but NETCDF_FILE is also common. - integer, optional, intent(in) :: threading !< A flag indicating whether one (SINGLE_FILE) - !! or multiple PEs (MULTIPLE) participate in I/O. - !! With the default, the root PE does I/O. - integer, optional, intent(in) :: fileset !< A flag indicating whether multiple PEs doing I/O due - !! to threading=MULTIPLE write to the same file (SINGLE_FILE) - !! or to one file per PE (MULTIPLE, the default). - logical, optional, intent(in) :: nohdrs !< If nohdrs is .TRUE., headers are not written to - !! ASCII files. The default is .false. - type(domain2d), optional, intent(in) :: domain !< A domain2d type that describes the decomposition - type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< A MOM_Domain that describes the decomposition - - if (present(MOM_Domain)) then - call mpp_open(unit, filename, action=action, form=form, threading=threading, fileset=fileset, & - nohdrs=nohdrs, domain=MOM_Domain%mpp_domain) - else - call mpp_open(unit, filename, action=action, form=form, threading=threading, fileset=fileset, & - nohdrs=nohdrs, domain=domain) - endif -end subroutine open_file_unit - -!> open_file opens a file for parallel or single-file I/O. -subroutine open_file_type(IO_handle, filename, action, MOM_domain, threading, fileset) +subroutine open_file(IO_handle, filename, action, MOM_domain, threading, fileset) type(file_type), intent(inout) :: IO_handle !< The handle for the opened file character(len=*), intent(in) :: filename !< The path name of the file being opened integer, optional, intent(in) :: action !< A flag indicating whether the file can be read @@ -355,63 +294,59 @@ subroutine open_file_type(IO_handle, filename, action, MOM_domain, threading, fi integer :: index_nc if (IO_handle%open_to_write) then - call MOM_error(WARNING, "open_file_type called for file "//trim(filename)//& + call MOM_error(WARNING, "open_file called for file "//trim(filename)//& " with an IO_handle that is already open to to write.") return endif if (IO_handle%open_to_read) then - call MOM_error(FATAL, "open_file_type called for file "//trim(filename)//& + call MOM_error(FATAL, "open_file called for file "//trim(filename)//& " with an IO_handle that is already open to to read.") endif file_mode = WRITEONLY_FILE ; if (present(action)) file_mode = action - if (FMS2_writes .and. present(MOM_Domain)) then - if (.not.associated(IO_handle%fileobj)) allocate (IO_handle%fileobj) - - ! The FMS1 interface automatically appends .nc if necessary, but FMS2 interface does not. - index_nc = index(trim(filename), ".nc") - if (index_nc > 0) then - filename_tmp = trim(filename) - else - filename_tmp = trim(filename)//".nc" - if (is_root_PE()) call MOM_error(WARNING, "Open_file is appending .nc to the filename "//trim(filename)) - endif + ! Domains are currently required to use FMS I/O. + ! NOTE: We restrict FMS2 IO usage to domain-based files due to issues with + ! string-based attributes in certain compilers. + ! But we may relax this requirement in the future. + if (.not. present(MOM_Domain)) & + call MOM_error(FATAL, 'open_file: FMS I/O requires a domain input.') - if (file_mode == WRITEONLY_FILE) then ; mode = "write" - elseif (file_mode == APPEND_FILE) then ; mode = "append" - elseif (file_mode == OVERWRITE_FILE) then ; mode = "overwrite" - elseif (file_mode == READONLY_FILE) then ; mode = "read" - else - call MOM_error(FATAL, "open_file_type called with unrecognized action.") - endif + if (.not.associated(IO_handle%fileobj)) allocate (IO_handle%fileobj) - IO_handle%num_times = 0 - IO_handle%file_time = 0.0 - if ((file_mode == APPEND_FILE) .and. file_exists(filename_tmp, MOM_Domain)) then - ! Determine the latest file time and number of records so far. - success = fms2_open_file(fileObj_read, trim(filename_tmp), "read", MOM_domain%mpp_domain) - call get_unlimited_dimension_name(fileObj_read, dim_unlim_name) - if (len_trim(dim_unlim_name) > 0) & - call get_dimension_size(fileObj_read, trim(dim_unlim_name), IO_handle%num_times) - if (IO_handle%num_times > 0) & - call fms2_read_data(fileObj_read, trim(dim_unlim_name), IO_handle%file_time, & - unlim_dim_level=IO_handle%num_times) - call fms2_close_file(fileObj_read) - endif + ! The FMS1 interface automatically appends .nc if necessary, but FMS2 interface does not. + index_nc = index(trim(filename), ".nc") + if (index_nc > 0) then + filename_tmp = trim(filename) + else + filename_tmp = trim(filename)//".nc" + if (is_root_PE()) call MOM_error(WARNING, "Open_file is appending .nc to the filename "//trim(filename)) + endif - success = fms2_open_file(IO_handle%fileobj, trim(filename_tmp), trim(mode), MOM_domain%mpp_domain) - if (.not.success) call MOM_error(FATAL, "Unable to open file "//trim(filename_tmp)) - IO_handle%FMS2_file = .true. - elseif (present(MOM_Domain)) then - call mpp_open(IO_handle%unit, filename, action=file_mode, form=NETCDF_FILE, threading=threading, & - fileset=fileset, domain=MOM_Domain%mpp_domain) - IO_handle%FMS2_file = .false. + if (file_mode == WRITEONLY_FILE) then ; mode = "write" + elseif (file_mode == APPEND_FILE) then ; mode = "append" + elseif (file_mode == OVERWRITE_FILE) then ; mode = "overwrite" + elseif (file_mode == READONLY_FILE) then ; mode = "read" else - call mpp_open(IO_handle%unit, filename, action=file_mode, form=NETCDF_FILE, threading=threading, & - fileset=fileset) - IO_handle%FMS2_file = .false. + call MOM_error(FATAL, "open_file called with unrecognized action.") + endif + + IO_handle%num_times = 0 + IO_handle%file_time = 0.0 + if ((file_mode == APPEND_FILE) .and. file_exists(filename_tmp, MOM_Domain)) then + ! Determine the latest file time and number of records so far. + success = fms2_open_file(fileObj_read, trim(filename_tmp), "read", MOM_domain%mpp_domain) + dim_unlim_name = find_unlimited_dimension_name(fileObj_read) + if (len_trim(dim_unlim_name) > 0) & + call get_dimension_size(fileObj_read, trim(dim_unlim_name), IO_handle%num_times) + if (IO_handle%num_times > 0) & + call fms2_read_data(fileObj_read, trim(dim_unlim_name), IO_handle%file_time, & + unlim_dim_level=IO_handle%num_times) + call fms2_close_file(fileObj_read) endif + + success = fms2_open_file(IO_handle%fileobj, trim(filename_tmp), trim(mode), MOM_domain%mpp_domain) + if (.not.success) call MOM_error(FATAL, "Unable to open file "//trim(filename_tmp)) IO_handle%filename = trim(filename) if (file_mode == READONLY_FILE) then @@ -420,7 +355,7 @@ subroutine open_file_type(IO_handle, filename, action, MOM_domain, threading, fi IO_handle%open_to_read = .false. ; IO_handle%open_to_write = .true. endif -end subroutine open_file_type +end subroutine open_file !> open_file opens an ascii file for parallel or single-file I/O using Fortran read and write calls. subroutine open_ASCII_file(unit, file, action, threading, fileset) @@ -539,23 +474,14 @@ subroutine get_file_info(IO_handle, ndim, nvar, ntime) character(len=256) :: dim_unlim_name ! name of the unlimited dimension in the file integer :: ndims, nvars, natts, ntimes - if (IO_handle%FMS2_file) then - if (present(ndim)) ndim = get_num_dimensions(IO_handle%fileobj) - if (present(nvar)) nvar = get_num_variables(IO_handle%fileobj) - if (present(ntime)) then - ntime = 0 - call get_unlimited_dimension_name(IO_handle%fileobj, dim_unlim_name) - if (len_trim(dim_unlim_name) > 0) & - call get_dimension_size(IO_handle%fileobj, trim(dim_unlim_name), ntime) - endif - else - call mpp_get_info(IO_handle%unit, ndims, nvars, natts, ntimes ) - - if (present(ndim)) ndim = ndims - if (present(nvar)) nvar = nvars - if (present(ntime)) ntime = ntimes + if (present(ndim)) ndim = get_num_dimensions(IO_handle%fileobj) + if (present(nvar)) nvar = get_num_variables(IO_handle%fileobj) + if (present(ntime)) then + ntime = 0 + dim_unlim_name = find_unlimited_dimension_name(IO_handle%fileobj) + if (len_trim(dim_unlim_name) > 0) & + call get_dimension_size(IO_handle%fileobj, trim(dim_unlim_name), ntime) endif - end subroutine get_file_info @@ -575,12 +501,9 @@ subroutine get_file_times(IO_handle, time_values, ntime) if (present(ntime)) ntime = ntimes if (ntimes > 0) then allocate(time_values(ntimes)) - if (IO_handle%FMS2_file) then - call get_unlimited_dimension_name(IO_handle%fileobj, dim_unlim_name) + dim_unlim_name = find_unlimited_dimension_name(IO_handle%fileobj) + if (len_trim(dim_unlim_name) > 0) & call fms2_read_data(IO_handle%fileobj, trim(dim_unlim_name), time_values) - else - call mpp_get_times(IO_handle%unit, time_values) - endif endif end subroutine get_file_times @@ -590,7 +513,6 @@ subroutine get_file_fields(IO_handle, fields) type(file_type), intent(in) :: IO_handle !< Handle for a file that is open for I/O type(fieldtype), dimension(:), intent(inout) :: fields !< Field-type descriptions of all of !! the variables in a file. - type(mpp_fieldtype), dimension(size(fields)) :: mpp_fields ! Fieldtype structures for the variables character(len=256), dimension(size(fields)) :: var_names ! The names of all variables character(len=256) :: units ! The units of a variable as recorded in the file character(len=2048) :: longname ! The long-name of a variable as recorded in the file @@ -601,39 +523,25 @@ subroutine get_file_fields(IO_handle, fields) nvar = size(fields) ! Local variables - if (IO_handle%FMS2_file) then - call get_variable_names(IO_handle%fileobj, var_names) - do i=1,nvar - fields(i)%name = trim(var_names(i)) - longname = "" - if (variable_att_exists(IO_handle%fileobj, var_names(i), "long_name")) & - call get_variable_attribute(IO_handle%fileobj, var_names(i), "long_name", longname) - fields(i)%longname = trim(longname) - units = "" - if (variable_att_exists(IO_handle%fileobj, var_names(i), "units")) & - call get_variable_attribute(IO_handle%fileobj, var_names(i), "units", units) - fields(i)%units = trim(units) - - fields(i)%valid_chksum = variable_att_exists(IO_handle%fileobj, var_names(i), "checksum") - if (fields(i)%valid_chksum) then - call get_variable_attribute(IO_handle%fileobj, var_names(i), 'checksum', checksum_char) - ! If there are problems, there might need to be code added to handle commas. - read (checksum_char(1:16), '(Z16)') fields(i)%chksum_read - endif - enddo - else - call mpp_get_fields(IO_handle%unit, mpp_fields) - do i=1,nvar - fields(i)%FT = mpp_fields(i) - call mpp_get_atts(fields(i)%FT, name=fields(i)%name, units=units, longname=longname, & - checksum=checksum_file) - fields(i)%longname = trim(longname) - fields(i)%units = trim(units) - fields(i)%valid_chksum = mpp_attribute_exist(fields(i)%FT, "checksum") - if (fields(i)%valid_chksum) fields(i)%chksum_read = checksum_file(1) - enddo - endif - + call get_variable_names(IO_handle%fileobj, var_names) + do i=1,nvar + fields(i)%name = trim(var_names(i)) + longname = "" + if (variable_att_exists(IO_handle%fileobj, var_names(i), "long_name")) & + call get_variable_attribute(IO_handle%fileobj, var_names(i), "long_name", longname) + fields(i)%longname = trim(longname) + units = "" + if (variable_att_exists(IO_handle%fileobj, var_names(i), "units")) & + call get_variable_attribute(IO_handle%fileobj, var_names(i), "units", units) + fields(i)%units = trim(units) + + fields(i)%valid_chksum = variable_att_exists(IO_handle%fileobj, var_names(i), "checksum") + if (fields(i)%valid_chksum) then + call get_variable_attribute(IO_handle%fileobj, var_names(i), 'checksum', checksum_char) + ! If there are problems, there might need to be code added to handle commas. + read (checksum_char(1:16), '(Z16)') fields(i)%chksum_read + endif + enddo end subroutine get_file_fields !> Extract information from a field type, as stored or as found in a file @@ -678,33 +586,26 @@ function field_exists(filename, field_name, domain, no_domain, MOM_domain) domainless = no_domain endif - if (FMS2_reads) then - field_exists = .false. - if (file_exists(filename)) then - if (domainless) then - success = fms2_open_file(fileObj_simple, trim(filename), "read") - if (success) then - field_exists = variable_exists(fileObj_simple, field_name) - call fms2_close_file(fileObj_simple) - endif + field_exists = .false. + if (file_exists(filename)) then + if (domainless) then + success = fms2_open_file(fileObj_simple, trim(filename), "read") + if (success) then + field_exists = variable_exists(fileObj_simple, field_name) + call fms2_close_file(fileObj_simple) + endif + else + if (present(MOM_domain)) then + success = fms2_open_file(fileObj_dd, trim(filename), "read", MOM_domain%mpp_domain) else - if (present(MOM_domain)) then - success = fms2_open_file(fileObj_dd, trim(filename), "read", MOM_domain%mpp_domain) - else - success = fms2_open_file(fileObj_dd, trim(filename), "read", domain) - endif - if (success) then - field_exists = variable_exists(fileobj_dd, field_name) - call fms2_close_file(fileObj_dd) - endif + success = fms2_open_file(fileObj_dd, trim(filename), "read", domain) + endif + if (success) then + field_exists = variable_exists(fileobj_dd, field_name) + call fms2_close_file(fileObj_dd) endif endif - elseif (present(MOM_domain)) then - field_exists = field_exist(filename, field_name, domain=MOM_domain%mpp_domain, no_domain=no_domain) - else - field_exists = field_exist(filename, field_name, domain=domain, no_domain=no_domain) endif - end function field_exists !> Given filename and fieldname, this subroutine returns the size of the field in the file @@ -728,72 +629,68 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) integer :: size_indices(4) ! Mapping of size index to FMS1 convention integer :: idx, swap - if (FMS2_reads) then - field_exists = .false. - if (file_exists(filename)) then - success = fms2_open_file(fileObj_read, trim(filename), "read") - if (success) then - field_exists = variable_exists(fileobj_read, fieldname) - if (field_exists) then - ndims = get_variable_num_dimensions(fileobj_read, fieldname) - if (ndims > size(sizes)) call MOM_error(FATAL, & - "get_field_size called with too few sizes for "//trim(fieldname)//" in "//trim(filename)) - call get_variable_size(fileobj_read, fieldname, sizes(1:ndims)) - - do i=ndims+1,size(sizes) ; sizes(i) = 0 ; enddo - - ! If sizes exceeds ndims, then we fallback to the FMS1 convention - ! where sizes has at least 4 dimension, and try to position values. - if (size(sizes) > ndims) then - ! Assume FMS1 positioning rules: (nx, ny, nz, nt, ...) - if (size(sizes) < 4) & - call MOM_error(FATAL, "If sizes(:) exceeds field dimensions, "& - &"then its length must be at least 4.") - - ! Fall back to the FMS1 default values of 1 (from mpp field%size) - sizes(ndims+1:) = 1 - - ! Gather the field dimension names - allocate(dimnames(ndims)) - dimnames(:) = "" - call get_variable_dimension_names(fileObj_read, trim(fieldname), & - dimnames) - - ! Test the dimensions against standard (x,y,t) names and attributes - allocate(is_x(ndims), is_y(ndims), is_t(ndims)) - is_x(:) = .false. - is_y(:) = .false. - is_t(:) = .false. - call categorize_axes(fileObj_read, filename, ndims, dimnames, & - is_x, is_y, is_t) - - ! Currently no z-test is supported, so disable assignment with 0 - size_indices = [ & - find_index(is_x), & - find_index(is_y), & - 0, & - find_index(is_t) & - ] - - do i = 1, size(size_indices) - idx = size_indices(i) - if (idx > 0) then - swap = sizes(i) - sizes(i) = sizes(idx) - sizes(idx) = swap - endif - enddo - - deallocate(is_x, is_y, is_t) - deallocate(dimnames) - endif + field_exists = .false. + if (file_exists(filename)) then + success = fms2_open_file(fileObj_read, trim(filename), "read") + if (success) then + field_exists = variable_exists(fileobj_read, fieldname) + if (field_exists) then + ndims = get_variable_num_dimensions(fileobj_read, fieldname) + if (ndims > size(sizes)) call MOM_error(FATAL, & + "get_field_size called with too few sizes for "//trim(fieldname)//" in "//trim(filename)) + call get_variable_size(fileobj_read, fieldname, sizes(1:ndims)) + + do i=ndims+1,size(sizes) ; sizes(i) = 0 ; enddo + + ! If sizes exceeds ndims, then we fallback to the FMS1 convention + ! where sizes has at least 4 dimension, and try to position values. + if (size(sizes) > ndims) then + ! Assume FMS1 positioning rules: (nx, ny, nz, nt, ...) + if (size(sizes) < 4) & + call MOM_error(FATAL, "If sizes(:) exceeds field dimensions, "& + &"then its length must be at least 4.") + + ! Fall back to the FMS1 default values of 1 (from mpp field%size) + sizes(ndims+1:) = 1 + + ! Gather the field dimension names + allocate(dimnames(ndims)) + dimnames(:) = "" + call get_variable_dimension_names(fileObj_read, trim(fieldname), & + dimnames) + + ! Test the dimensions against standard (x,y,t) names and attributes + allocate(is_x(ndims), is_y(ndims), is_t(ndims)) + is_x(:) = .false. + is_y(:) = .false. + is_t(:) = .false. + call categorize_axes(fileObj_read, filename, ndims, dimnames, & + is_x, is_y, is_t) + + ! Currently no z-test is supported, so disable assignment with 0 + size_indices = [ & + find_index(is_x), & + find_index(is_y), & + 0, & + find_index(is_t) & + ] + + do i = 1, size(size_indices) + idx = size_indices(i) + if (idx > 0) then + swap = sizes(i) + sizes(i) = sizes(idx) + sizes(idx) = swap + endif + enddo + + deallocate(is_x, is_y, is_t) + deallocate(dimnames) endif endif endif - if (present(field_found)) field_found = field_exists - else - call field_size(filename, fieldname, sizes, field_found=field_found, no_domain=no_domain) endif + if (present(field_found)) field_found = field_exists end subroutine get_field_size @@ -830,10 +727,7 @@ subroutine get_axis_data( axis, dat ) if (size(axis%ax_data) > size(dat)) call MOM_error(FATAL, & "get_axis_data called with too small of an output data array for "//trim(axis%name)) do i=1,size(axis%ax_data) ; dat(i) = axis%ax_data(i) ; enddo - elseif (.not.FMS2_writes) then - call mpp_get_axis_data( axis%AT, dat ) endif - end subroutine get_axis_data !> This routine uses the fms_io subroutine read_data to read a scalar named @@ -859,7 +753,7 @@ subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain logical :: has_time_dim ! True if the variable has an unlimited time axis. logical :: success ! True if the file was successfully opened - if (present(MOM_Domain) .and. FMS2_reads) then + if (present(MOM_Domain)) then ! Open the FMS2 file-set. success = fms2_open_file(fileobj_DD, filename, "read", MOM_domain%mpp_domain) if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) @@ -877,7 +771,7 @@ subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain ! Close the file-set. if (check_if_open(fileobj_DD)) call fms2_close_file(fileobj_DD) - elseif (FMS2_reads) then + else ! Open the FMS2 file-set. success = fms2_open_file(fileObj, trim(filename), "read") if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) @@ -896,10 +790,6 @@ subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain ! Close the file-set. if (check_if_open(fileobj)) call fms2_close_file(fileobj) - elseif (present(MOM_Domain)) then ! Read the variable using the FMS-1 interface. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, timelevel=timelevel) - else - call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) endif if (present(scale)) then ; if (scale /= 1.0) then @@ -931,7 +821,7 @@ subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain logical :: has_time_dim ! True if the variable has an unlimited time axis. logical :: success ! True if the file was successfully opened - if (present(MOM_Domain) .and. FMS2_reads) then + if (present(MOM_Domain)) then ! Open the FMS2 file-set. success = fms2_open_file(fileobj_DD, filename, "read", MOM_domain%mpp_domain) if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) @@ -949,7 +839,7 @@ subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain ! Close the file-set. if (check_if_open(fileobj_DD)) call fms2_close_file(fileobj_DD) - elseif (FMS2_reads) then + else ! Open the FMS2 file-set. success = fms2_open_file(fileObj, trim(filename), "read") if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) @@ -968,10 +858,6 @@ subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain ! Close the file-set. if (check_if_open(fileobj)) call fms2_close_file(fileobj) - elseif (present(MOM_Domain)) then ! Read the variable using the FMS-1 interface. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, timelevel=timelevel) - else - call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) endif if (present(scale)) then ; if (scale /= 1.0) then @@ -1004,29 +890,24 @@ subroutine read_field_2d(filename, fieldname, data, MOM_Domain, & logical :: has_time_dim ! True if the variable has an unlimited time axis. logical :: success ! True if the file was successfully opened - if (FMS2_reads) then - ! Open the FMS2 file-set. - success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) - if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "read_field_2d: ", filename, & - var_to_read, has_time_dim, timelevel, position) - - ! Read the data. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, var_to_read, data) - endif + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, "read_field_2d: ", filename, & + var_to_read, has_time_dim, timelevel, position) - ! Close the file-set. - if (check_if_open(fileobj)) call fms2_close_file(fileobj) - else ! Read the variable using the FMS-1 interface. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=position) + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) endif + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif @@ -1060,7 +941,7 @@ subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_dom character(len=96) :: var_to_read ! Name of variable to read from the netcdf file logical :: success ! True if the file was successfully opened - if (present(MOM_Domain) .and. FMS2_reads) then + if (present(MOM_Domain)) then ! Open the FMS2 file-set. success = fms2_open_file(fileobj_DD, filename, "read", MOM_domain%mpp_domain) if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) @@ -1074,7 +955,7 @@ subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_dom ! Close the file-set. if (check_if_open(fileobj_DD)) call fms2_close_file(fileobj_DD) - elseif (FMS2_reads) then + else ! Open the FMS2 file-set. success = fms2_open_file(fileObj, trim(filename), "read") if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) @@ -1088,11 +969,6 @@ subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_dom ! Close the file-set. if (check_if_open(fileobj)) call fms2_close_file(fileobj) - elseif (present(MOM_Domain)) then ! Read the variable using the FMS-1 interface. - call read_data(filename, fieldname, data, start, nread, domain=MOM_Domain%mpp_domain, & - no_domain=no_domain) - else - call read_data(filename, fieldname, data, start, nread, no_domain=no_domain) endif if (present(scale)) then ; if (scale /= 1.0) then @@ -1130,34 +1006,97 @@ subroutine read_field_3d(filename, fieldname, data, MOM_Domain, & logical :: has_time_dim ! True if the variable has an unlimited time axis. logical :: success ! True if the file was successfully opened - if (FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, "read_field_3d: ", filename, & + var_to_read, has_time_dim, timelevel, position) + + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + + if (present(scale)) then ; if (scale /= 1.0) then + call rescale_comp_data(MOM_Domain, data, scale) + endif ; endif + +end subroutine read_field_3d + +!> This routine uses the fms_io subroutine read_data to read a region from a distributed or +!! global 3-D data field named "fieldname" from file "filename". +subroutine read_field_3d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale) + character(len=*), intent(in) :: filename !< The name of the file to read + character(len=*), intent(in) :: fieldname !< The variable name of the data in the file + real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data + !! should be read + integer, dimension(:), intent(in) :: start !< The starting index to read in each of 3 + !! dimensions. For this 3-d read, the + !! 4th value is always 1. + integer, dimension(:), intent(in) :: nread !< The number of points to read in each of 4 + !! dimensions. For this 3-d read, the + !! 4th values are always 1. + type(MOM_domain_type), & + optional, intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition + logical, optional, intent(in) :: no_domain !< If present and true, this variable does not + !! use domain decomposion. + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before it is returned. + + ! Local variables + type(FmsNetcdfFile_t) :: fileObj ! A handle to a non-domain-decomposed file + type(FmsNetcdfDomainFile_t) :: fileobj_DD ! A handle to a domain-decomposed file object + character(len=96) :: var_to_read ! Name of variable to read from the netcdf file + logical :: success ! True if the file was successfully opened + + if (present(MOM_Domain)) then ! Open the FMS2 file-set. - success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) + success = fms2_open_file(fileobj_DD, filename, "read", MOM_domain%mpp_domain) if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "read_field_3d: ", filename, & - var_to_read, has_time_dim, timelevel, position) + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_2d_region: ", & + filename, var_to_read) ! Read the data. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, var_to_read, data) - endif + call fms2_read_data(fileobj_DD, var_to_read, data, corner=start(1:3), edge_lengths=nread(1:3)) + + ! Close the file-set. + if (check_if_open(fileobj_DD)) call fms2_close_file(fileobj_DD) + else + ! Open the FMS2 file-set. + success = fms2_open_file(fileObj, trim(filename), "read") + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file, and determine whether it + ! has a time dimension. + call find_varname_in_file(fileObj, fieldname, "read_field_2d_region: ", filename, var_to_read) + + ! Read the data. + call fms2_read_data(fileobj, var_to_read, data, corner=start(1:3), edge_lengths=nread(1:3)) ! Close the file-set. if (check_if_open(fileobj)) call fms2_close_file(fileobj) - else ! Read the variable using the FMS-1 interface. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=position) endif if (present(scale)) then ; if (scale /= 1.0) then - call rescale_comp_data(MOM_Domain, data, scale) + if (present(MOM_Domain)) then + call rescale_comp_data(MOM_Domain, data, scale) + else + ! Dangerously rescale the whole array + data(:,:,:) = scale*data(:,:,:) + endif endif ; endif -end subroutine read_field_3d +end subroutine read_field_3d_region !> This routine uses the fms_io subroutine read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for @@ -1182,29 +1121,24 @@ subroutine read_field_4d(filename, fieldname, data, MOM_Domain, & character(len=96) :: var_to_read ! Name of variable to read from the netcdf file logical :: success ! True if the file was successfully opened - if (FMS2_reads) then - ! Open the FMS2 file-set. - success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) - if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - - ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "read_field_4d: ", filename, & - var_to_read, has_time_dim, timelevel, position) + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - ! Read the data. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, var_to_read, data) - endif + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, "read_field_4d: ", filename, & + var_to_read, has_time_dim, timelevel, position) - ! Close the file-set. - if (check_if_open(fileobj)) call fms2_close_file(fileobj) - else ! Read the variable using the FMS-1 interface. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=position) + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) endif + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif @@ -1226,29 +1160,25 @@ subroutine read_field_0d_int(filename, fieldname, data, timelevel) logical :: success ! If true, the file was opened successfully ! This routine might not be needed for MOM6. - if (FMS2_reads) then - ! Open the FMS2 file-set. - success = fms2_open_file(fileObj, trim(filename), "read") - if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - ! Find the matching case-insensitive variable name in the file, and determine whether it - ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "read_field_0d_int: ", filename, & - var_to_read, has_time_dim, timelevel) + ! Open the FMS2 file-set. + success = fms2_open_file(fileObj, trim(filename), "read") + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - ! Read the data. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, var_to_read, data) - endif + ! Find the matching case-insensitive variable name in the file, and determine whether it + ! has a time dimension. + call find_varname_in_file(fileObj, fieldname, "read_field_0d_int: ", filename, & + var_to_read, has_time_dim, timelevel) - ! Close the file-set. - if (check_if_open(fileobj)) call fms2_close_file(fileobj) + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) else - call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) + call fms2_read_data(fileobj, var_to_read, data) endif + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) end subroutine read_field_0d_int !> This routine uses the fms_io subroutine read_data to read a 1-D integer @@ -1267,29 +1197,25 @@ subroutine read_field_1d_int(filename, fieldname, data, timelevel) logical :: success ! If true, the file was opened successfully ! This routine might not be needed for MOM6. - if (FMS2_reads) then - ! Open the FMS2 file-set. - success = fms2_open_file(fileObj, trim(filename), "read") - if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - ! Find the matching case-insensitive variable name in the file, and determine whether it - ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "read_field_1d_int: ", filename, & - var_to_read, has_time_dim, timelevel) + ! Open the FMS2 file-set. + success = fms2_open_file(fileObj, trim(filename), "read") + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - ! Read the data. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, var_to_read, data) - endif + ! Find the matching case-insensitive variable name in the file, and determine whether it + ! has a time dimension. + call find_varname_in_file(fileObj, fieldname, "read_field_1d_int: ", filename, & + var_to_read, has_time_dim, timelevel) - ! Close the file-set. - if (check_if_open(fileobj)) call fms2_close_file(fileobj) + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) else - call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) + call fms2_read_data(fileobj, var_to_read, data) endif + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) end subroutine read_field_1d_int @@ -1325,36 +1251,29 @@ subroutine read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MO elseif (stagger == AGRID) then ; u_pos = CENTER ; v_pos = CENTER ; endif endif - if (FMS2_reads) then - ! Open the FMS2 file-set. - success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) - if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - - ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. - call prepare_to_read_var(fileobj, u_fieldname, "read_vector_2d: ", filename, & - u_var, has_time_dim, timelevel, position=u_pos) - call prepare_to_read_var(fileobj, v_fieldname, "read_vector_2d: ", filename, & - v_var, has_time_dim, timelevel, position=v_pos) - - ! Read the u-data and v-data. There would already been an error message for one - ! of the variables if they are inconsistent in having an unlimited dimension. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, u_var, u_data, unlim_dim_level=timelevel) - call fms2_read_data(fileobj, v_var, v_data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, u_var, u_data) - call fms2_read_data(fileobj, v_var, v_data) - endif - - ! Close the file-set. - if (check_if_open(fileobj)) call fms2_close_file(fileobj) - else ! Read the variable using the FMS-1 interface. - call read_data(filename, u_fieldname, u_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=u_pos) - call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=v_pos) + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. + call prepare_to_read_var(fileobj, u_fieldname, "read_vector_2d: ", filename, & + u_var, has_time_dim, timelevel, position=u_pos) + call prepare_to_read_var(fileobj, v_fieldname, "read_vector_2d: ", filename, & + v_var, has_time_dim, timelevel, position=v_pos) + + ! Read the u-data and v-data. There would already been an error message for one + ! of the variables if they are inconsistent in having an unlimited dimension. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, u_var, u_data, unlim_dim_level=timelevel) + call fms2_read_data(fileobj, v_var, v_data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, u_var, u_data) + call fms2_read_data(fileobj, v_var, v_data) endif + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, u_data, scale) call rescale_comp_data(MOM_Domain, v_data, scale) @@ -1395,36 +1314,29 @@ subroutine read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MO elseif (stagger == AGRID) then ; u_pos = CENTER ; v_pos = CENTER ; endif endif - if (FMS2_reads) then - ! Open the FMS2 file-set. - success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) - if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) - - ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. - call prepare_to_read_var(fileobj, u_fieldname, "read_vector_3d: ", filename, & - u_var, has_time_dim, timelevel, position=u_pos) - call prepare_to_read_var(fileobj, v_fieldname, "read_vector_3d: ", filename, & - v_var, has_time_dim, timelevel, position=v_pos) - - ! Read the u-data and v-data, dangerously assuming either both or neither have time dimensions. - ! There would already been an error message for one of the variables if they are inconsistent. - if (present(timelevel) .and. has_time_dim) then - call fms2_read_data(fileobj, u_var, u_data, unlim_dim_level=timelevel) - call fms2_read_data(fileobj, v_var, v_data, unlim_dim_level=timelevel) - else - call fms2_read_data(fileobj, u_var, u_data) - call fms2_read_data(fileobj, v_var, v_data) - endif - - ! Close the file-set. - if (check_if_open(fileobj)) call fms2_close_file(fileobj) - else ! Read the variable using the FMS-1 interface. - call read_data(filename, u_fieldname, u_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=u_pos) - call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=v_pos) + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. + call prepare_to_read_var(fileobj, u_fieldname, "read_vector_3d: ", filename, & + u_var, has_time_dim, timelevel, position=u_pos) + call prepare_to_read_var(fileobj, v_fieldname, "read_vector_3d: ", filename, & + v_var, has_time_dim, timelevel, position=v_pos) + + ! Read the u-data and v-data, dangerously assuming either both or neither have time dimensions. + ! There would already been an error message for one of the variables if they are inconsistent. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, u_var, u_data, unlim_dim_level=timelevel) + call fms2_read_data(fileobj, v_var, v_data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, u_var, u_data) + call fms2_read_data(fileobj, v_var, v_data) endif + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, u_data, scale) call rescale_comp_data(MOM_Domain, v_data, scale) @@ -1682,9 +1594,9 @@ subroutine categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t if (variable_exists(fileobj, trim(dim_names(i)))) then cartesian = "" if (variable_att_exists(fileobj, trim(dim_names(i)), "cartesian_axis")) then - call get_variable_attribute(fileobj, trim(dim_names(i)), "cartesian_axis", cartesian) + call get_variable_attribute(fileobj, trim(dim_names(i)), "cartesian_axis", cartesian(1:1)) elseif (variable_att_exists(fileobj, trim(dim_names(i)), "axis")) then - call get_variable_attribute(fileobj, trim(dim_names(i)), "axis", cartesian) + call get_variable_attribute(fileobj, trim(dim_names(i)), "axis", cartesian(1:1)) endif cartesian = adjustl(cartesian) if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. @@ -1807,14 +1719,11 @@ subroutine write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_c ! Local variables integer :: time_index - if (IO_handle%FMS2_file .and. present(tstamp)) then + if (present(tstamp)) then time_index = write_time_if_later(IO_handle, tstamp) call write_data(IO_handle%fileobj, trim(field_md%name), field, unlim_dim_level=time_index) - elseif (IO_handle%FMS2_file) then - call write_data(IO_handle%fileobj, trim(field_md%name), field) else - call mpp_write(IO_handle%unit, field_md%FT, MOM_domain%mpp_domain, field, tstamp=tstamp, & - tile_count=tile_count, default_data=fill_value) + call write_data(IO_handle%fileobj, trim(field_md%name), field) endif end subroutine write_field_4d @@ -1831,14 +1740,11 @@ subroutine write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_c ! Local variables integer :: time_index - if (IO_handle%FMS2_file .and. present(tstamp)) then + if (present(tstamp)) then time_index = write_time_if_later(IO_handle, tstamp) call write_data(IO_handle%fileobj, trim(field_md%name), field, unlim_dim_level=time_index) - elseif (IO_handle%FMS2_file) then - call write_data(IO_handle%fileobj, trim(field_md%name), field) else - call mpp_write(IO_handle%unit, field_md%FT, MOM_domain%mpp_domain, field, tstamp=tstamp, & - tile_count=tile_count, default_data=fill_value) + call write_data(IO_handle%fileobj, trim(field_md%name), field) endif end subroutine write_field_3d @@ -1855,14 +1761,11 @@ subroutine write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_c ! Local variables integer :: time_index - if (IO_handle%FMS2_file .and. present(tstamp)) then + if (present(tstamp)) then time_index = write_time_if_later(IO_handle, tstamp) call write_data(IO_handle%fileobj, trim(field_md%name), field, unlim_dim_level=time_index) - elseif (IO_handle%FMS2_file) then - call write_data(IO_handle%fileobj, trim(field_md%name), field) else - call mpp_write(IO_handle%unit, field_md%FT, MOM_domain%mpp_domain, field, tstamp=tstamp, & - tile_count=tile_count, default_data=fill_value) + call write_data(IO_handle%fileobj, trim(field_md%name), field) endif end subroutine write_field_2d @@ -1876,13 +1779,11 @@ subroutine write_field_1d(IO_handle, field_md, field, tstamp) ! Local variables integer :: time_index - if (IO_handle%FMS2_file .and. present(tstamp)) then + if (present(tstamp)) then time_index = write_time_if_later(IO_handle, tstamp) call write_data(IO_handle%fileobj, trim(field_md%name), field, unlim_dim_level=time_index) - elseif (IO_handle%FMS2_file) then - call write_data(IO_handle%fileobj, trim(field_md%name), field) else - call mpp_write(IO_handle%unit, field_md%FT, field, tstamp=tstamp) + call write_data(IO_handle%fileobj, trim(field_md%name), field) endif end subroutine write_field_1d @@ -1896,13 +1797,11 @@ subroutine write_field_0d(IO_handle, field_md, field, tstamp) ! Local variables integer :: time_index - if (IO_handle%FMS2_file .and. present(tstamp)) then + if (present(tstamp)) then time_index = write_time_if_later(IO_handle, tstamp) call write_data(IO_handle%fileobj, trim(field_md%name), field, unlim_dim_level=time_index) - elseif (IO_handle%FMS2_file) then - call write_data(IO_handle%fileobj, trim(field_md%name), field) else - call mpp_write(IO_handle%unit, field_md%FT, field, tstamp=tstamp) + call write_data(IO_handle%fileobj, trim(field_md%name), field) endif end subroutine write_field_0d @@ -1918,11 +1817,10 @@ integer function write_time_if_later(IO_handle, field_time) if ((field_time > IO_handle%file_time) .or. (IO_handle%num_times == 0)) then IO_handle%file_time = field_time IO_handle%num_times = IO_handle%num_times + 1 - if (IO_handle%FMS2_file) then - call get_unlimited_dimension_name(IO_handle%fileobj, dim_unlim_name) - call write_data(IO_handle%fileobj, trim(dim_unlim_name), (/field_time/), & - corner=(/IO_handle%num_times/), edge_lengths=(/1/)) - endif + dim_unlim_name = find_unlimited_dimension_name(IO_handle%fileobj) + if (len_trim(dim_unlim_name) > 0) & + call write_data(IO_handle%fileobj, trim(dim_unlim_name), [field_time], & + corner=[IO_handle%num_times], edge_lengths=[1]) endif write_time_if_later = IO_handle%num_times @@ -1935,18 +1833,13 @@ subroutine MOM_write_axis(IO_handle, axis) integer :: is, ie - if (IO_handle%FMS2_file) then - if (axis%domain_decomposed) then - ! FMS2 does not domain-decompose 1d arrays, so we explicitly slice it - call get_global_io_domain_indices(IO_handle%fileobj, trim(axis%name), is, ie) - call write_data(IO_handle%fileobj, trim(axis%name), axis%ax_data(is:ie)) - else - call write_data(IO_handle%fileobj, trim(axis%name), axis%ax_data) - endif + if (axis%domain_decomposed) then + ! FMS2 does not domain-decompose 1d arrays, so we explicitly slice it + call get_global_io_domain_indices(IO_handle%fileobj, trim(axis%name), is, ie) + call write_data(IO_handle%fileobj, trim(axis%name), axis%ax_data(is:ie)) else - call mpp_write(IO_handle%unit, axis%AT) + call write_data(IO_handle%fileobj, trim(axis%name), axis%ax_data) endif - end subroutine MOM_write_axis !> Store information about an axis in a previously defined axistype and write this @@ -1973,12 +1866,10 @@ subroutine write_metadata_axis(IO_handle, axis, name, units, longname, cartesian integer :: position ! A flag indicating the axis staggering position. integer :: i, isc, iec, global_size - if (IO_handle%FMS2_file) then - if (is_dimension_registered(IO_handle%fileobj, trim(name))) then - call MOM_error(FATAL, "write_metadata_axis was called more than once for axis "//trim(name)//& - " in file "//trim(IO_handle%filename)) - return - endif + if (is_dimension_registered(IO_handle%fileobj, trim(name))) then + call MOM_error(FATAL, "write_metadata_axis was called more than once for axis "//trim(name)//& + " in file "//trim(IO_handle%filename)) + return endif axis%name = trim(name) @@ -1986,82 +1877,73 @@ subroutine write_metadata_axis(IO_handle, axis, name, units, longname, cartesian "Data is already allocated in a call to write_metadata_axis for axis "//& trim(name)//" in file "//trim(IO_handle%filename)) - if (IO_handle%FMS2_file) then - is_x = .false. ; is_y = .false. ; is_t = .false. - position = CENTER - if (present(cartesian)) then - cart = trim(adjustl(cartesian)) - if ((index(cart, "X") == 1) .or. (index(cart, "x") == 1)) is_x = .true. - if ((index(cart, "Y") == 1) .or. (index(cart, "y") == 1)) is_y = .true. - if ((index(cart, "T") == 1) .or. (index(cart, "t") == 1)) is_t = .true. - endif - - ! For now, we assume that all horizontal axes are domain-decomposed. - if (is_x .or. is_y) & - axis%domain_decomposed = .true. - - if (is_x) then - if (present(edge_axis)) then ; if (edge_axis) position = EAST_FACE ; endif - call register_axis(IO_handle%fileobj, trim(name), 'x', domain_position=position) - elseif (is_y) then - if (present(edge_axis)) then ; if (edge_axis) position = NORTH_FACE ; endif - call register_axis(IO_handle%fileobj, trim(name), 'y', domain_position=position) - elseif (is_t .and. .not.present(data)) then - ! This is the unlimited (time) dimension. - call register_axis(IO_handle%fileobj, trim(name), unlimited) - else - if (.not.present(data)) call MOM_error(FATAL,"MOM_io:register_diagnostic_axis: "//& - "An axis_length argument is required to register the axis "//trim(name)) - call register_axis(IO_handle%fileobj, trim(name), size(data)) - endif + is_x = .false. ; is_y = .false. ; is_t = .false. + position = CENTER + if (present(cartesian)) then + cart = trim(adjustl(cartesian)) + if ((index(cart, "X") == 1) .or. (index(cart, "x") == 1)) is_x = .true. + if ((index(cart, "Y") == 1) .or. (index(cart, "y") == 1)) is_y = .true. + if ((index(cart, "T") == 1) .or. (index(cart, "t") == 1)) is_t = .true. + endif - if (present(data)) then - ! With FMS2, the data for the axis labels has to match the computational domain on this PE. - if (present(domain)) then - ! The commented-out code on the next ~11 lines runs but there is missing data in the output file - ! call mpp_get_compute_domain(domain, isc, iec) - ! call mpp_get_global_domain(domain, size=global_size) - ! if (size(data) == global_size) then - ! allocate(axis%ax_data(iec+1-isc)) ; axis%ax_data(:) = data(isc:iec) - ! ! A simpler set of labels: do i=1,iec-isc ; axis%ax_data(i) = real(isc + i) - 1.0 ; enddo - ! elseif (size(data) == global_size+1) then - ! ! This is an edge axis. Note the effective SW indexing convention here. - ! allocate(axis%ax_data(iec+2-isc)) ; axis%ax_data(:) = data(isc:iec+1) - ! ! A simpler set of labels: do i=1,iec+1-isc ; axis%ax_data(i) = real(isc + i) - 1.5 ; enddo - ! else - ! call MOM_error(FATAL, "Unexpected size of data for "//trim(name)//" in write_metadata_axis.") - ! endif - - ! This works for a simple 1x1 IO layout, but gives errors for nontrivial IO layouts - allocate(axis%ax_data(size(data))) ; axis%ax_data(:) = data(:) - - else ! Store the entire array of axis labels. - allocate(axis%ax_data(size(data))) ; axis%ax_data(:) = data(:) - endif - endif + ! For now, we assume that all horizontal axes are domain-decomposed. + if (is_x .or. is_y) & + axis%domain_decomposed = .true. + + if (is_x) then + if (present(edge_axis)) then ; if (edge_axis) position = EAST_FACE ; endif + call register_axis(IO_handle%fileobj, trim(name), 'x', domain_position=position) + elseif (is_y) then + if (present(edge_axis)) then ; if (edge_axis) position = NORTH_FACE ; endif + call register_axis(IO_handle%fileobj, trim(name), 'y', domain_position=position) + elseif (is_t .and. .not.present(data)) then + ! This is the unlimited (time) dimension. + call register_axis(IO_handle%fileobj, trim(name), unlimited) + else + if (.not.present(data)) call MOM_error(FATAL,"MOM_io:register_diagnostic_axis: "//& + "An axis_length argument is required to register the axis "//trim(name)) + call register_axis(IO_handle%fileobj, trim(name), size(data)) + endif + if (present(data)) then + ! With FMS2, the data for the axis labels has to match the computational domain on this PE. + if (present(domain)) then + ! The commented-out code on the next ~11 lines runs but there is missing data in the output file + ! call mpp_get_compute_domain(domain, isc, iec) + ! call mpp_get_global_domain(domain, size=global_size) + ! if (size(data) == global_size) then + ! allocate(axis%ax_data(iec+1-isc)) ; axis%ax_data(:) = data(isc:iec) + ! ! A simpler set of labels: do i=1,iec-isc ; axis%ax_data(i) = real(isc + i) - 1.0 ; enddo + ! elseif (size(data) == global_size+1) then + ! ! This is an edge axis. Note the effective SW indexing convention here. + ! allocate(axis%ax_data(iec+2-isc)) ; axis%ax_data(:) = data(isc:iec+1) + ! ! A simpler set of labels: do i=1,iec+1-isc ; axis%ax_data(i) = real(isc + i) - 1.5 ; enddo + ! else + ! call MOM_error(FATAL, "Unexpected size of data for "//trim(name)//" in write_metadata_axis.") + ! endif + + ! This works for a simple 1x1 IO layout, but gives errors for nontrivial IO layouts + allocate(axis%ax_data(size(data))) ; axis%ax_data(:) = data(:) - ! Now create the variable that describes this axis. - call register_field(IO_handle%fileobj, trim(name), "double", dimensions=(/name/)) - if (len_trim(longname) > 0) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'long_name', & - trim(longname), len_trim(longname)) - if (len_trim(units) > 0) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'units', & - trim(units), len_trim(units)) - if (present(cartesian)) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'cartesian_axis', & - trim(cartesian), len_trim(cartesian)) - if (present(sense)) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'sense', sense) - else - if (present(data)) then + else ! Store the entire array of axis labels. allocate(axis%ax_data(size(data))) ; axis%ax_data(:) = data(:) endif - - call mpp_write_meta(IO_handle%unit, axis%AT, name, units, longname, cartesian=cartesian, sense=sense, & - domain=domain, data=data, calendar=calendar) endif + + + ! Now create the variable that describes this axis. + call register_field(IO_handle%fileobj, trim(name), "double", dimensions=(/name/)) + if (len_trim(longname) > 0) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'long_name', & + trim(longname), len_trim(longname)) + if (len_trim(units) > 0) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'units', & + trim(units), len_trim(units)) + if (present(cartesian)) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'cartesian_axis', & + trim(cartesian), len_trim(cartesian)) + if (present(sense)) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'sense', sense) end subroutine write_metadata_axis !> Store information about an output variable in a previously defined fieldtype and write this @@ -2083,35 +1965,27 @@ subroutine write_metadata_field(IO_handle, field, axes, name, units, longname, & ! Local variables character(len=256), dimension(size(axes)) :: dim_names ! The names of the dimensions - type(mpp_axistype), dimension(size(axes)) :: mpp_axes ! The array of mpp_axistypes for this variable character(len=16) :: prec_string ! A string specifying the precision with which to save this variable character(len=64) :: checksum_string ! checksum character array created from checksum argument integer :: i, ndims ndims = size(axes) - if (IO_handle%FMS2_file) then - do i=1,ndims ; dim_names(i) = trim(axes(i)%name) ; enddo - prec_string = "double" ; if (present(pack)) then ; if (pack > 1) prec_string = "float" ; endif - call register_field(IO_handle%fileobj, trim(name), trim(prec_string), dimensions=dim_names) - if (len_trim(longname) > 0) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'long_name', & - trim(longname), len_trim(longname)) - if (len_trim(units) > 0) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'units', & - trim(units), len_trim(units)) - if (present(standard_name)) & - call register_variable_attribute(IO_handle%fileobj, trim(name), 'standard_name', & - trim(standard_name), len_trim(standard_name)) - if (present(checksum)) then - write (checksum_string,'(Z16)') checksum(1) ! Z16 is the hexadecimal format code - call register_variable_attribute(IO_handle%fileobj, trim(name), "checksum", & - trim(checksum_string), len_trim(checksum_string)) - endif - else - do i=1,ndims ; mpp_axes(i) = axes(i)%AT ; enddo - call mpp_write_meta(IO_handle%unit, field%FT, mpp_axes, name, units, longname, & - pack=pack, standard_name=standard_name, checksum=checksum) - ! unused opt. args: min=min, max=max, fill=fill, scale=scale, add=add, & + do i=1,ndims ; dim_names(i) = trim(axes(i)%name) ; enddo + prec_string = "double" ; if (present(pack)) then ; if (pack > 1) prec_string = "float" ; endif + call register_field(IO_handle%fileobj, trim(name), trim(prec_string), dimensions=dim_names) + if (len_trim(longname) > 0) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'long_name', & + trim(longname), len_trim(longname)) + if (len_trim(units) > 0) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'units', & + trim(units), len_trim(units)) + if (present(standard_name)) & + call register_variable_attribute(IO_handle%fileobj, trim(name), 'standard_name', & + trim(standard_name), len_trim(standard_name)) + if (present(checksum)) then + write (checksum_string,'(Z16)') checksum(1) ! Z16 is the hexadecimal format code + call register_variable_attribute(IO_handle%fileobj, trim(name), "checksum", & + trim(checksum_string), len_trim(checksum_string)) endif ! Store information in the field-type, regardless of which interfaces are used. @@ -2129,12 +2003,37 @@ subroutine write_metadata_global(IO_handle, name, attribute) character(len=*), intent(in) :: name !< The name in the file of this global attribute character(len=*), intent(in) :: attribute !< The value of this attribute - if (IO_handle%FMS2_file) then - call register_global_attribute(IO_handle%fileobj, name, attribute, len_trim(attribute)) - else - call mpp_write_meta(IO_handle%unit, name, cval=attribute) - endif - + call register_global_attribute(IO_handle%fileobj, name, attribute, len_trim(attribute)) end subroutine write_metadata_global +!> Return unlimited dimension name in file, or empty string if none exists. +function find_unlimited_dimension_name(fileobj) result(label) + type(FmsNetcdfDomainFile_t), intent(in) :: fileobj + !< File handle + character(len=:), allocatable :: label + !< Unlimited dimension name, or empty string if none exists + + integer :: ndims + !< Number of dimensions + character(len=256), allocatable :: dim_names(:) + !< File handle dimension names + integer :: i + !< Loop index + + ndims = get_num_dimensions(fileobj) + allocate(dim_names(ndims)) + call get_dimension_names(fileobj, dim_names) + + do i = 1, ndims + if (is_dimension_unlimited(fileobj, dim_names(i))) then + label = trim(dim_names(i)) + exit + endif + enddo + deallocate(dim_names) + + if (.not. allocated(label)) & + label = '' +end function find_unlimited_dimension_name + end module MOM_io_infra diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 137f6cee9b..a341fd1835 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1456,24 +1456,30 @@ subroutine ALE_writeCoordinateFile( CS, GV, directory ) character(len=240) :: filepath - filepath = trim(directory) // trim("Vertical_coordinate") + filepath = trim(directory) // trim("Vertical_coordinate.nc") call write_regrid_file(CS%regridCS, GV, filepath) end subroutine ALE_writeCoordinateFile !> Set h to coordinate values for fixed coordinate systems -subroutine ALE_initThicknessToCoord( CS, G, GV, h ) +subroutine ALE_initThicknessToCoord( CS, G, GV, h, height_units ) type(ALE_CS), intent(inout) :: CS !< module control structure type(ocean_grid_type), intent(in) :: G !< module grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< layer thickness in thickness units + !! [H ~> m or kg m-2] or height units [Z ~> m] + logical, optional, intent(in) :: height_units !< If present and true, the + !! thicknesses are in height units ! Local variables + real :: scale ! A scaling value for the thicknesses [nondim] or [H Z-1 ~> nondim or kg m-3] integer :: i, j + scale = GV%Z_to_H + if (present(height_units)) then ; if (height_units) scale = 1.0 ; endif do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%Z_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j)+G%Z_ref ) + h(i,j,:) = scale * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j)+G%Z_ref ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_hybgen_regrid.F90 b/src/ALE/MOM_hybgen_regrid.F90 index f89e15d930..dc7c90a079 100644 --- a/src/ALE/MOM_hybgen_regrid.F90 +++ b/src/ALE/MOM_hybgen_regrid.F90 @@ -100,7 +100,7 @@ subroutine init_hybgen_regrid(CS, GV, US, param_file) "The pressure that is used for calculating the coordinate "//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & - units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=2.0e7, scale=US%Pa_to_RL2_T2) call get_param(param_file, mdl, "HYBGEN_MIN_THICKNESS", CS%min_thickness, & "The minimum layer thickness allowed when regridding with Hybgen.", & diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index b9d74c01a2..9da4e95b24 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -7,7 +7,7 @@ module MOM_regridding use MOM_file_parser, only : param_file_type, get_param, log_param use MOM_io, only : file_exists, field_exists, field_size, MOM_read_data use MOM_io, only : vardesc, var_desc, SINGLE_FILE -use MOM_io, only : MOM_infra_file, MOM_field +use MOM_io, only : MOM_netCDF_file, MOM_field use MOM_io, only : create_MOM_file, MOM_write_field use MOM_io, only : verify_variable_units, slasher use MOM_unit_scaling, only : unit_scale_type @@ -23,7 +23,7 @@ module MOM_regridding use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA use regrid_consts, only : REGRIDDING_ARBITRARY, REGRIDDING_SIGMA_SHELF_ZSTAR use regrid_consts, only : REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_ADAPTIVE -use regrid_interp, only : interp_CS_type, set_interp_scheme, set_interp_extrap +use regrid_interp, only : interp_CS_type, set_interp_scheme, set_interp_extrap, set_interp_answer_date use coord_zlike, only : init_coord_zlike, zlike_CS, set_zlike_params, build_zstar_column, end_coord_zlike use coord_sigma, only : init_coord_sigma, sigma_CS, set_sigma_params, build_sigma_column, end_coord_sigma @@ -212,6 +212,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: remap_answers_2018 integer :: remap_answer_date ! The vintage of the remapping expressions to use. + integer :: regrid_answer_date ! The vintage of the regridding expressions to use. real :: tmpReal, P_Ref real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha @@ -291,6 +292,13 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_answer_date) call set_regrid_params(CS, remap_answer_date=remap_answer_date) + call get_param(param_file, mdl, "REGRIDDING_ANSWER_DATE", regrid_answer_date, & + "The vintage of the expressions and order of arithmetic to use for regridding. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions.", & + default=20181231) ! ### change to default=default_answer_date) + call set_regrid_params(CS, regrid_answer_date=regrid_answer_date) endif if (main_parameters .and. coord_is_state_dependent) then @@ -530,7 +538,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m endif ! ensure CS%ref_pressure is rescaled properly - CS%ref_pressure = (US%kg_m3_to_R * US%m_s_to_L_T**2) * CS%ref_pressure + CS%ref_pressure = US%Pa_to_RL2_T2 * CS%ref_pressure if (allocated(rho_target)) then call set_target_densities(CS, US%kg_m3_to_R*rho_target) @@ -552,13 +560,13 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m "The pressure that is used for calculating the coordinate "//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & - units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=2.0e7, scale=US%Pa_to_RL2_T2) else call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & "The pressure that is used for calculating the diagnostic coordinate "//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& "This is only used for the RHO coordinate.", & - units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=2.0e7, scale=US%Pa_to_RL2_T2) endif call get_param(param_file, mdl, create_coord_param(param_prefix, "REGRID_COMPRESSIBILITY_FRACTION", param_suffix), & tmpReal, & @@ -2082,7 +2090,7 @@ subroutine write_regrid_file( CS, GV, filepath ) type(vardesc) :: vars(2) type(MOM_field) :: fields(2) - type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset + type(MOM_netCDF_file) :: IO_handle ! The I/O handle of the fileset real :: ds(GV%ke), dsi(GV%ke+1) if (CS%regridding_scheme == REGRIDDING_HYBGEN) then @@ -2233,7 +2241,7 @@ end function getCoordinateShortName subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_grid_weight, & interp_scheme, depth_of_time_filter_shallow, depth_of_time_filter_deep, & compress_fraction, ref_pressure, & - integrate_downward_for_e, remap_answers_2018, remap_answer_date, & + integrate_downward_for_e, remap_answers_2018, remap_answer_date, regrid_answer_date, & adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin, adaptDrho0) type(regridding_CS), intent(inout) :: CS !< Regridding control structure logical, optional, intent(in) :: boundary_extrapolation !< Extrapolate in boundary cells @@ -2252,6 +2260,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri !! that recover the remapping answers from 2018. Otherwise !! use more robust but mathematically equivalent expressions. integer, optional, intent(in) :: remap_answer_date !< The vintage of the expressions to use for remapping + integer, optional, intent(in) :: regrid_answer_date !< The vintage of the expressions to use for regridding real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale [nondim]. real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region [H ~> m or kg m-2]. real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity [nondim]. @@ -2265,6 +2274,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(interp_scheme)) call set_interp_scheme(CS%interp_CS, interp_scheme) if (present(boundary_extrapolation)) call set_interp_extrap(CS%interp_CS, boundary_extrapolation) + if (present(regrid_answer_date)) call set_interp_answer_date(CS%interp_CS, regrid_answer_date) if (present(old_grid_weight)) then if (old_grid_weight<0. .or. old_grid_weight>1.) & diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index e119ce9d53..641ae7e6c2 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -33,14 +33,12 @@ module regrid_interp !! boundary cells logical :: boundary_extrapolation - !> The vintage of the expressions to use for remapping - integer :: answer_date = 20181231 - !### Changing this to 99991231 changes answers in rho and Hycom1 configurations. - !### There is no point where the value of answer_date is reset. + !> The vintage of the expressions to use for regridding + integer :: answer_date = 99991231 end type interp_CS_type public regridding_set_ppolys, build_and_interpolate_grid -public set_interp_scheme, set_interp_extrap +public set_interp_scheme, set_interp_extrap, set_interp_answer_date ! List of interpolation schemes integer, parameter :: INTERPOLATION_P1M_H2 = 0 !< O(h^2) @@ -547,4 +545,13 @@ subroutine set_interp_extrap(CS, extrap) CS%boundary_extrapolation = extrap end subroutine set_interp_extrap +!> Store the value of the answer_date in the interp_CS +subroutine set_interp_answer_date(CS, answer_date) + type(interp_CS_type), intent(inout) :: CS !< A control structure for regrid_interp + integer, intent(in) :: answer_date !< An integer encoding the vintage of + !! the expressions to use for regridding + + CS%answer_date = answer_date +end subroutine set_interp_answer_date + end module regrid_interp diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ba7152ea30..89d1ee2004 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -91,7 +91,7 @@ module MOM use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_hor_index, only : rotate_hor_index -use MOM_interface_heights, only : find_eta +use MOM_interface_heights, only : find_eta, calc_derived_thermo use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end use MOM_interface_filter, only : interface_filter_CS use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init, VarMix_end @@ -135,14 +135,12 @@ module MOM use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state use MOM_tracer_flow_control, only : tracer_flow_control_end, call_tracer_register_obc_segments use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid -use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init -use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init, unit_scaling_end use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_variables, only : rotate_surface_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd -use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units use MOM_wave_interface, only : wave_parameters_CS, waves_end, waves_register_restarts use MOM_wave_interface, only : Update_Stokes_Drift @@ -653,6 +651,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call create_group_pass(pass_tau_ustar_psurf, forces%taux, forces%tauy, G%Domain) if (associated(forces%ustar)) & call create_group_pass(pass_tau_ustar_psurf, forces%ustar, G%Domain) + if (associated(forces%tau_mag)) & + call create_group_pass(pass_tau_ustar_psurf, forces%tau_mag, G%Domain) if (associated(forces%p_surf)) & call create_group_pass(pass_tau_ustar_psurf, forces%p_surf, G%Domain) if (G%nonblocking_updates) then @@ -1229,7 +1229,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%thickness_diffuse .or. CS%interface_filter) .and. & .not.CS%thickness_diffuse_first) then - if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) + if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_MKS) if (CS%thickness_diffuse) then call cpu_clock_begin(id_clock_thick_diff) @@ -1238,7 +1238,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) - if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_m) + if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_MKS) call cpu_clock_end(id_clock_thick_diff) call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) if (showCallTree) call callTree_waypoint("finished thickness_diffuse (step_MOM)") @@ -1257,19 +1257,19 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! apply the submesoscale mixed layer restratification parameterization if (CS%mixedlayer_restrat) then if (CS%debug) then - call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Pre-mixedlayer_restrat uhtr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & - CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp) + CS%visc%sfc_buoy_flx, CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp) call cpu_clock_end(id_clock_ml_restrat) call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) if (CS%debug) then - call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Post-mixedlayer_restrat [uv]htr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) endif endif @@ -1329,9 +1329,9 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (CS%debug) then call cpu_clock_begin(id_clock_other) - call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1, scale=US%C_to_degC) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1, scale=US%S_to_ppt) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & @@ -1402,6 +1402,12 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call create_group_pass(pass_T_S, CS%tv%T, G%Domain, To_All+Omit_Corners, halo=1) call create_group_pass(pass_T_S, CS%tv%S, G%Domain, To_All+Omit_Corners, halo=1) call do_group_pass(pass_T_S, G%Domain, clock=id_clock_pass) + halo_sz = 1 + endif + + ! Update derived thermodynamic quantities. + if (allocated(CS%tv%SpV_avg)) then + call calc_derived_thermo(CS%tv, h, G, GV, US, halo=halo_sz) endif endif @@ -1494,9 +1500,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (.not.CS%adiabatic) then if (CS%debug) then call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) - call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G, US, haloshift=0) call check_redundant("Pre-diabatic ", u, v, G, unscale=US%L_T_to_m_s) @@ -1583,6 +1589,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call create_group_pass(pass_uv_T_S_h, h, G%Domain, halo=dynamics_stencil) call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) + ! Update derived thermodynamic quantities. + if (allocated(tv%SpV_avg)) then + call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil) + endif + if (CS%debug .and. CS%use_ALE_algorithm) then call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) @@ -1600,9 +1611,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (CS%debug) then call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) - call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1, scale=US%C_to_degC) @@ -1625,13 +1636,19 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_end(id_clock_adiabatic) if (associated(tv%T)) then - call create_group_pass(pass_T_S, tv%T, G%Domain, To_All+Omit_Corners, halo=1) - call create_group_pass(pass_T_S, tv%S, G%Domain, To_All+Omit_Corners, halo=1) + dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo) + call create_group_pass(pass_T_S, tv%T, G%Domain, To_All+Omit_Corners, halo=dynamics_stencil) + call create_group_pass(pass_T_S, tv%S, G%Domain, To_All+Omit_Corners, halo=dynamics_stencil) call do_group_pass(pass_T_S, G%Domain, clock=id_clock_pass) if (CS%debug) then if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1, scale=US%C_to_degC) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1, scale=US%S_to_ppt) endif + + ! Update derived thermodynamic quantities. + if (allocated(tv%SpV_avg)) then + call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil) + endif endif endif ! endif for the block "if (.not.CS%adiabatic)" @@ -1678,6 +1695,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(time_type), pointer :: accumulated_time => NULL() type(time_type), pointer :: vertical_time => NULL() + integer :: dynamics_stencil ! The computational stencil for the calculations + ! in the dynamic core. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz ! 3D pointers @@ -1850,6 +1869,12 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS fluxes%fluxes_used = .true. + ! Update derived thermodynamic quantities. + if (allocated(CS%tv%SpV_avg)) then + dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo) + call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=dynamics_stencil) + endif + if (last_iter) then accumulated_time = real_to_time(0.0) endif @@ -1980,7 +2005,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real :: conv2watt ! A conversion factor from temperature fluxes to heat ! fluxes [J m-2 H-1 C-1 ~> J m-3 degC-1 or J kg-1 degC-1] real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] - real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -2200,7 +2224,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This is here in case these values are used inappropriately. use_frazil = .false. ; bound_salinity = .false. - CS%tv%P_Ref = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 + CS%tv%P_Ref = 2.0e7*US%Pa_to_RL2_T2 if (use_temperature) then call get_param(param_file, "MOM", "FRAZIL", use_frazil, & "If true, water freezes if it gets too cold, and the "//& @@ -2236,7 +2260,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The pressure that is used for calculating the coordinate "//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & - units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=2.0e7, scale=US%Pa_to_RL2_T2) if (bulkmixedlayer) then call get_param(param_file, "MOM", "NKML", nkml, & @@ -2822,6 +2846,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif + ! Allocate any derived equation of state fields. + if (use_temperature .and. .not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then + allocate(CS%tv%SpV_avg(isd:ied,jsd:jed,nz), source=0.0) + endif + if (use_ice_shelf .and. CS%debug) then call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0) call hchksum(CS%mass_shelf, "MOM:mass_shelf", G%HI, haloshift=0,scale=US%RZ_to_kg_m2) @@ -2864,7 +2893,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! all examples. !### if (CS%debug) then call uvchksum("Pre ALE adjust init cond [uv]", CS%u, CS%v, G%HI, haloshift=1) - call hchksum(CS%h,"Pre ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(CS%h,"Pre ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_MKS) endif call callTree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)") call adjustGridForIntegrity(CS%ALE_CSp, G, GV, CS%h ) @@ -2904,7 +2933,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug) then call uvchksum("Post ALE adjust init cond [uv]", CS%u, CS%v, G%HI, haloshift=1) - call hchksum(CS%h, "Post ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(CS%h, "Post ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_MKS) if (use_temperature) then call hchksum(CS%tv%T, "Post ALE adjust init cond T", G%HI, haloshift=1, scale=US%C_to_degC) call hchksum(CS%tv%S, "Post ALE adjust init cond S", G%HI, haloshift=1, scale=US%S_to_ppt) @@ -3108,6 +3137,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call do_group_pass(pass_uv_T_S_h, G%Domain) + ! Update derived thermodynamic quantities. + if (allocated(CS%tv%SpV_avg)) then + call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=dynamics_stencil) + endif + if (associated(CS%visc%Kv_shear)) & call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) @@ -3119,16 +3153,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_obsolete_diagnostics(param_file, CS%diag) if (use_frazil) then - if (query_initialized(CS%tv%frazil, "frazil", restart_CSp)) then - ! Test whether the dimensional rescaling has changed for heat content. - if ((US%J_kg_to_Q_restart*US%kg_m3_to_R_restart*US%m_to_Z_restart /= 0.0) .and. & - (US%J_kg_to_Q_restart*US%kg_m3_to_R_restart*US%m_to_Z_restart /= 1.0) ) then - QRZ_rescale = 1.0 / (US%J_kg_to_Q_restart*US%kg_m3_to_R_restart*US%m_to_Z_restart) - do j=js,je ; do i=is,ie - CS%tv%frazil(i,j) = QRZ_rescale * CS%tv%frazil(i,j) - enddo ; enddo - endif - else + if (.not.query_initialized(CS%tv%frazil, "frazil", restart_CSp)) then CS%tv%frazil(:,:) = 0.0 call set_initialized(CS%tv%frazil, "frazil", restart_CSp) endif @@ -3138,39 +3163,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%p_surf_prev_set = query_initialized(CS%p_surf_prev, "p_surf_prev", restart_CSp) if (CS%p_surf_prev_set) then - ! Test whether the dimensional rescaling has changed for pressure. - if ((US%kg_m3_to_R_restart*US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart**2 /= US%kg_m3_to_R_restart * US%m_to_L_restart**2) ) then - RL2_T2_rescale = US%s_to_T_restart**2 / (US%kg_m3_to_R_restart*US%m_to_L_restart**2) - do j=js,je ; do i=is,ie - CS%p_surf_prev(i,j) = RL2_T2_rescale * CS%p_surf_prev(i,j) - enddo ; enddo - endif - call pass_var(CS%p_surf_prev, G%domain) endif endif - if (use_ice_shelf .and. associated(CS%Hml)) then - if (query_initialized(CS%Hml, "hML", restart_CSp)) then - ! Test whether the dimensional rescaling has changed for depths. - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= 1.0) ) then - Z_rescale = 1.0 / US%m_to_Z_restart - do j=js,je ; do i=is,ie - CS%Hml(i,j) = Z_rescale * CS%Hml(i,j) - enddo ; enddo - endif - endif - endif - - if (query_initialized(CS%ave_ssh_ibc, "ave_ssh", restart_CSp)) then - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= 1.0) ) then - Z_rescale = 1.0 / US%m_to_Z_restart - do j=js,je ; do i=is,ie - CS%ave_ssh_ibc(i,j) = Z_rescale * CS%ave_ssh_ibc(i,j) - enddo ; enddo - endif - else + if (.not.query_initialized(CS%ave_ssh_ibc, "ave_ssh", restart_CSp)) then if (CS%split) then call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, dZref=G%Z_ref) else @@ -3197,10 +3194,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! initialize stochastic physics call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) - !### This could perhaps go here instead of in finish_MOM_initialization? - ! call fix_restart_scaling(GV) - ! call fix_restart_unit_scaling(US) - call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) @@ -3228,11 +3221,6 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) ! Pointers for convenience G => CS%G ; GV => CS%GV ; US => CS%US - !### Move to initialize_MOM? - call fix_restart_scaling(GV, unscaled=.true.) - call fix_restart_unit_scaling(US, unscaled=.true.) - - if (CS%use_particles) then call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v) endif @@ -3384,18 +3372,6 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) endif ! Register scalar unit conversion factors. - call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & - "Height unit conversion factor", "Z meter-1") - call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & - "Thickness unit conversion factor", "H meter-1") - call register_restart_field(US%m_to_L_restart, "m_to_L", .false., restart_CSp, & - "Length unit conversion factor", "L meter-1") - call register_restart_field(US%s_to_T_restart, "s_to_T", .false., restart_CSp, & - "Time unit conversion factor", "T second-1") - call register_restart_field(US%kg_m3_to_R_restart, "kg_m3_to_R", .false., restart_CSp, & - "Density unit conversion factor", "R m3 kg-1") - call register_restart_field(US%J_kg_to_Q_restart, "J_kg_to_Q", .false., restart_CSp, & - "Heat content unit conversion factor.", units="Q kg J-1") call register_restart_field(CS%first_dir_restart, "First_direction", .false., restart_CSp, & "Indicator of the first direction in split calculations.", "nondim") @@ -3994,6 +3970,7 @@ subroutine MOM_end(CS) if (associated(CS%Hml)) deallocate(CS%Hml) if (associated(CS%tv%salt_deficit)) deallocate(CS%tv%salt_deficit) if (associated(CS%tv%frazil)) deallocate(CS%tv%frazil) + if (allocated(CS%tv%SpV_avg)) deallocate(CS%tv%SpV_avg) if (associated(CS%tv%T)) then DEALLOC_(CS%T) ; CS%tv%T => NULL() ; DEALLOC_(CS%S) ; CS%tv%S => NULL() diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index dfacb40001..14c9b2e6dc 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -188,7 +188,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ p(i,j,1) = p_atm(i,j) enddo ; enddo else - ! oneatm = 101325.0 * US%kg_m3_to_R * US%m_s_to_L_T**2 ! 1 atm scaled to [R L2 T-2 ~> Pa] + ! oneatm = 101325.0 * US%Pa_to_RL2_T2 ! 1 atm scaled to [R L2 T-2 ~> Pa] !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 p(i,j,1) = 0.0 ! or oneatm diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index bb77a99c4c..40f759f4b8 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1661,15 +1661,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call uvchksum("BT [uv]hbt", uhbt, vhbt, CS%debug_BT_HI, haloshift=0, & scale=US%s_to_T*US%L_to_m**2*GV%H_to_m) call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0, scale=US%L_T_to_m_s) - call hchksum(eta, "BT Initial eta", CS%debug_BT_HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eta, "BT Initial eta", CS%debug_BT_HI, haloshift=0, scale=GV%H_to_MKS) call uvchksum("BT BT_force_[uv]", BT_force_u, BT_force_v, & CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2) if (interp_eta_PF) then - call hchksum(eta_PF_1, "BT eta_PF_1",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) - call hchksum(d_eta_PF, "BT d_eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eta_PF_1, "BT eta_PF_1",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_MKS) + call hchksum(d_eta_PF, "BT d_eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_MKS) else - call hchksum(eta_PF, "BT eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eta_PF_in, "BT eta_PF_in",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eta_PF, "BT eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_MKS) + call hchksum(eta_PF_in, "BT eta_PF_in",G%HI,haloshift=0, scale=GV%H_to_MKS) endif call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2) call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, haloshift=0, & @@ -2396,7 +2396,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, write(mesg,'("BT step ",I4)') n call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=iev-ie, & scale=US%L_T_to_m_s) - call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m) + call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_MKS) endif if (GV%Boussinesq) then @@ -3573,9 +3573,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) scalar_pair=.true.) if (present(h_u) .and. present(h_v)) & call uvchksum("btcalc h_[uv]", h_u, h_v, G%HI, haloshift=0, & - symmetric=.true., omit_corners=.true., scale=GV%H_to_m, & + symmetric=.true., omit_corners=.true., scale=GV%H_to_MKS, & scalar_pair=.true.) - call hchksum(h, "btcalc h",G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h, "btcalc h",G%HI, haloshift=1, scale=GV%H_to_MKS) endif end subroutine btcalc @@ -4318,8 +4318,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! drag piston velocity. character(len=80) :: wave_drag_var ! The wave drag piston velocity variable ! name in wave_drag_file. - real :: vel_rescale ! A rescaling factor for horizontal velocity from the representation in - ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. real :: det_de ! The partial derivative due to self-attraction and loading of the reference @@ -4788,8 +4786,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, dtbt_tmp = -1.0 if (query_initialized(CS%dtbt, "DTBT", restart_CS)) then dtbt_tmp = CS%dtbt - if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= 1.0)) & - dtbt_tmp = (1.0 / US%s_to_T_restart) * CS%dtbt endif ! Estimate the maximum stable barotropic time step. @@ -4948,11 +4944,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, do k=1,nz ; do J=js-1,je ; do i=is,ie CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k) enddo ; enddo ; enddo - elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%m_to_L_restart)) then - vel_rescale = US%s_to_T_restart / US%m_to_L_restart - do j=js,je ; do I=is-1,ie ; CS%ubtav(I,j) = vel_rescale * CS%ubtav(I,j) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; CS%vbtav(i,J) = vel_rescale * CS%vbtav(i,J) ; enddo ; enddo endif if (CS%gradual_BT_ICs) then @@ -4960,11 +4951,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, .NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo - elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%m_to_L_restart)) then - vel_rescale = US%s_to_T_restart / US%m_to_L_restart - do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = vel_rescale * CS%ubt_IC(I,j) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vel_rescale * CS%vbt_IC(i,J) ; enddo ; enddo endif endif ! Calculate other constants which are used for btstep. diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index bc908ee60c..4a9df04c4d 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -76,9 +76,9 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, & omit_corners=omit_corners, scale=scale_vel) - call hchksum(h, mesg//" h", G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_m) + call hchksum(h, mesg//" h", G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_MKS) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, symmetric=sym, & - omit_corners=omit_corners, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + omit_corners=omit_corners, scale=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= @@ -111,7 +111,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric, sym = .false. ; if (present(symmetric)) sym = symmetric call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, & omit_corners=omit_corners, scale=US%L_T_to_m_s) - call hchksum(h, mesg//" h",G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_m) + call hchksum(h, mesg//" h",G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_MKS) end subroutine MOM_state_chksum_3arg ! ============================================================================= diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index e1fb3d3278..9fed528e71 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -4,12 +4,13 @@ module MOM_density_integrals ! This file is part of MOM6. See LICENSE.md for the license. use MOM_EOS, only : EOS_type -use MOM_EOS, only : EOS_quadrature +use MOM_EOS, only : EOS_quadrature, EOS_domain use MOM_EOS, only : analytic_int_density_dz use MOM_EOS, only : analytic_int_specific_vol_dp use MOM_EOS, only : calculate_density use MOM_EOS, only : calculate_spec_vol use MOM_EOS, only : calculate_specific_vol_derivs +use MOM_EOS, only : average_specific_vol use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_hor_index, only : hor_index_type use MOM_string_functions, only : uppercase @@ -28,6 +29,7 @@ module MOM_density_integrals public int_specific_vol_dp public int_spec_vol_dp_generic_pcm public int_spec_vol_dp_generic_plm +public avg_specific_vol public find_depth_of_pressure_in_cell contains @@ -1613,6 +1615,36 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t end subroutine find_depth_of_pressure_in_cell +!> Calculate the average in situ specific volume across layers +subroutine avg_specific_vol(T, S, p_t, dp, HI, EOS, SpV_avg, halo_size) + type(hor_index_type), intent(in) :: HI !< The horizontal index structure + real, dimension(SZI_(HI),SZJ_(HI)), & + intent(in) :: T !< Potential temperature of the layer [C ~> degC] + real, dimension(SZI_(HI),SZJ_(HI)), & + intent(in) :: S !< Salinity of the layer [S ~> ppt] + real, dimension(SZI_(HI),SZJ_(HI)), & + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] + real, dimension(SZI_(HI),SZJ_(HI)), & + intent(in) :: dp !< Pressure change in the layer [R L2 T-2 ~> Pa] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + real, dimension(SZI_(HI),SZJ_(HI)), & + intent(inout) :: SpV_avg !< The vertical average specific volume + !! in the layer [R-1 ~> m3 kg-1] + integer, optional, intent(in) :: halo_size !< The number of halo points in which to work. + + ! Local variables + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer :: jsh, jeh, j, halo + + halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) + jsh = HI%jsc-halo ; jeh = HI%jec+halo + + EOSdom(:) = EOS_domain(HI, halo_size) + do j=jsh,jeh + call average_specific_vol(T(:,j), S(:,j), p_t(:,j), dp(:,j), SpV_avg(:,j), EOS, EOSdom) + enddo + +end subroutine avg_specific_vol !> Returns change in anomalous pressure change from top to non-dimensional !! position pos between z_t and z_b [R L2 T-2 ~> Pa] diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 74ab4e1f18..9fb1a6b356 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -407,7 +407,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G, unscale=US%L_T_to_m_s) - call check_redundant("Start predictor uh ", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + call check_redundant("Start predictor uh ", uh, vh, G, unscale=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) endif dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) @@ -641,16 +641,16 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + symmetric=sym, scale=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) ! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=1, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G, unscale=US%L_T_to_m_s) - call check_redundant("Predictor 1 uh", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + call check_redundant("Predictor 1 uh", uh, vh, G, unscale=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) endif ! up <- up + dt_pred d/dz visc d/dz up @@ -776,10 +776,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_MKS) ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G, unscale=US%L_T_to_m_s) - call check_redundant("Predictor uh ", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + call check_redundant("Predictor uh ", uh, vh, G, unscale=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) endif ! diffu = horizontal viscosity terms (u_av) @@ -868,9 +868,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("Corrector 1 [uv]", u, v, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h, "Corrector 1 h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h, "Corrector 1 h", G%HI, haloshift=1, scale=GV%H_to_MKS) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + symmetric=sym, scale=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & @@ -1063,7 +1063,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_MKS) ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif @@ -1246,14 +1246,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! This include declares and sets the variable "version". # include "version_variable.h" character(len=48) :: thickness_units, flux_units, eta_rest_name - real :: H_rescale ! A rescaling factor for thicknesses from the representation in a - ! restart file to the internal representation in this run [various units ~> 1] - real :: vel_rescale ! A rescaling factor for velocities from the representation in a - ! restart file to the internal representation in this run [various units ~> 1] - real :: uH_rescale ! A rescaling factor for thickness transports from the representation in a - ! restart file to the internal representation in this run [various units ~> 1] - real :: accel_rescale ! A rescaling factor for accelerations from the representation in a - ! restart file to the internal representation in this run [various units ~> 1] type(group_pass_type) :: pass_av_h_uvh logical :: debug_truncations logical :: read_uv, read_h2 @@ -1410,9 +1402,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) enddo ; enddo ; enddo call set_initialized(CS%eta, trim(eta_rest_name), restart_CS) - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then - H_rescale = 1.0 / GV%m_to_H_restart - do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo endif ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo @@ -1427,17 +1416,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param OBC=CS%OBC, BT=CS%barotropic_CSp, TD=thickness_diffuse_CSp) call set_initialized(CS%diffu, "diffu", restart_CS) call set_initialized(CS%diffv, "diffv", restart_CS) - else - if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart**2 /= US%m_to_L_restart) ) then - accel_rescale = US%s_to_T_restart**2 / US%m_to_L_restart - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB - CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie - CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) - enddo ; enddo ; enddo - endif endif if (.not. query_initialized(CS%u_av, "u2", restart_CS) .or. & @@ -1446,11 +1424,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = v(i,J,k) ; enddo ; enddo ; enddo call set_initialized(CS%u_av, "u2", restart_CS) call set_initialized(CS%v_av, "v2", restart_CS) - elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%m_to_L_restart) ) then - vel_rescale = US%s_to_T_restart / US%m_to_L_restart - do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif if (CS%store_CAu) then @@ -1504,15 +1477,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%h_av, "h2", restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) call set_initialized(CS%h_av, "h2", restart_CS) - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then - H_rescale = 1.0 / GV%m_to_H_restart - do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo - endif - if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= (GV%m_to_H_restart * US%m_to_L_restart**2)) ) then - uH_rescale = US%s_to_T_restart / (GV%m_to_H_restart * US%m_to_L_restart**2) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo endif endif endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index a3b7d604dd..a36fec3bb5 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -68,6 +68,9 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. + tau_mag => NULL(), & !< Magnitude of the wind stress averaged over tracer cells, + !! including any contributions from sub-gridscale variability + !! or gustiness [R L Z T-2 ~> Pa] ustar_gustless => NULL() !< surface friction velocity scale without any !! any augmentation for gustiness [Z T-1 ~> m s-1]. @@ -220,6 +223,8 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress [R L Z T-2 ~> Pa] tauy => NULL(), & !< meridional wind stress [R L Z T-2 ~> Pa] + tau_mag => NULL(), & !< Magnitude of the wind stress averaged over tracer cells, including any + !! contributions from sub-gridscale variability or gustiness [R L Z T-2 ~> Pa] ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean [R Z T-1 ~> kg m-2 s-1] @@ -357,6 +362,7 @@ module MOM_forcing_type integer :: id_taux = -1 integer :: id_tauy = -1 integer :: id_ustar = -1 + integer :: id_tau_mag = -1 integer :: id_psurf = -1 integer :: id_TKE_tidal = -1 @@ -1079,6 +1085,8 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) ! and js...je as their extent. if (associated(fluxes%ustar)) & call hchksum(fluxes%ustar, mesg//" fluxes%ustar", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + if (associated(fluxes%tau_mag)) & + call hchksum(fluxes%tau_mag, mesg//" fluxes%tau_mag", G%HI, haloshift=hshift, scale=US%RLZ_T2_to_Pa) if (associated(fluxes%buoy)) & call hchksum(fluxes%buoy, mesg//" fluxes%buoy ", G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**3) if (associated(fluxes%sw)) & @@ -1178,11 +1186,13 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) ! and js...je as their extent. if (associated(forces%taux) .and. associated(forces%tauy)) & call uvchksum(mesg//" forces%tau[xy]", forces%taux, forces%tauy, G%HI, & - haloshift=hshift, symmetric=.true., scale=US%RZ_T_to_kg_m2s*US%L_T_to_m_s) + haloshift=hshift, symmetric=.true., scale=US%RLZ_T2_to_Pa) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf", G%HI, haloshift=hshift, scale=US%RL2_T2_to_Pa) if (associated(forces%ustar)) & call hchksum(forces%ustar, mesg//" forces%ustar", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + if (associated(forces%tau_mag)) & + call hchksum(forces%tau_mag, mesg//" forces%tau_mag", G%HI, haloshift=hshift, scale=US%RLZ_T2_to_Pa) if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true., & @@ -1229,6 +1239,7 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) write(0,'(2a)') 'MOM_forcing_type, forcing_SinglePointPrint: Called from ',mesg write(0,'(a,2es15.3)') 'MOM_forcing_type, forcing_SinglePointPrint: lon,lat = ',G%geoLonT(i,j),G%geoLatT(i,j) call locMsg(fluxes%ustar,'ustar') + call locMsg(fluxes%tau_mag,'tau_mag') call locMsg(fluxes%buoy,'buoy') call locMsg(fluxes%sw,'sw') call locMsg(fluxes%sw_vis_dir,'sw_vis_dir') @@ -1297,18 +1308,22 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, Time, & 'Zonal surface stress from ocean interactions with atmos and ice', & - 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & + 'Pa', conversion=US%RLZ_T2_to_Pa, & standard_name='surface_downward_x_stress', cmor_field_name='tauuo', & cmor_units='N m-2', cmor_long_name='Surface Downward X Stress', & cmor_standard_name='surface_downward_x_stress') handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & 'Meridional surface stress ocean interactions with atmos and ice', & - 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & + 'Pa', conversion=US%RLZ_T2_to_Pa, & standard_name='surface_downward_y_stress', cmor_field_name='tauvo', & cmor_units='N m-2', cmor_long_name='Surface Downward Y Stress', & cmor_standard_name='surface_downward_y_stress') + handles%id_tau_mag = register_diag_field('ocean_model', 'tau_mag', diag%axesT1, Time, & + 'Average magnitude of the wind stress including contributions from gustiness', & + 'Pa', conversion=US%RLZ_T2_to_Pa) + handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & 'm s-1', conversion=US%Z_to_m*US%s_to_T) @@ -2021,6 +2036,7 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) + fluxes%tau_mag(i,j) = wt1*fluxes%tau_mag(i,j) + wt2*forces%tau_mag(i,j) enddo ; enddo else do j=js,je ; do i=is,ie @@ -2028,6 +2044,7 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j) fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j) + fluxes%tau_mag(i,j) = wt1*fluxes%tau_mag(i,j) + wt2*flux_tmp%tau_mag(i,j) enddo ; enddo endif @@ -2148,6 +2165,12 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) enddo ; enddo endif + if (associated(forces%tau_mag) .and. associated(fluxes%tau_mag)) then + do j=js,je ; do i=is,ie + fluxes%tau_mag(i,j) = forces%tau_mag(i,j) + enddo ; enddo + endif + if (do_pres) then if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then do j=js,je ; do i=is,ie @@ -2279,6 +2302,12 @@ subroutine copy_back_forcing_fields(fluxes, forces, G) enddo ; enddo endif + if (associated(forces%tau_mag) .and. associated(fluxes%tau_mag)) then + do j=js,je ; do i=is,ie + forces%tau_mag(i,j) = fluxes%tau_mag(i,j) + enddo ; enddo + endif + end subroutine copy_back_forcing_fields !> Offer mechanical forcing fields for diagnostics for those @@ -2915,6 +2944,9 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) & call post_data(handles%id_buoy, fluxes%buoy, diag) + if ((handles%id_tau_mag > 0) .and. associated(fluxes%tau_mag)) & + call post_data(handles%id_tau_mag, fluxes%tau_mag, diag) + if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & call post_data(handles%id_ustar, fluxes%ustar, diag) @@ -2985,6 +3017,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & call myAlloc(fluxes%ustar,isd,ied,jsd,jed, ustar) call myAlloc(fluxes%ustar_gustless,isd,ied,jsd,jed, ustar) + call myAlloc(fluxes%tau_mag,isd,ied,jsd,jed, ustar) call myAlloc(fluxes%evap,isd,ied,jsd,jed, water) call myAlloc(fluxes%lprec,isd,ied,jsd,jed, water) @@ -3118,6 +3151,7 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%tauy,isd,ied,JsdB,JedB, stress) call myAlloc(forces%ustar,isd,ied,jsd,jed, ustar) + call myAlloc(forces%tau_mag,isd,ied,jsd,jed, ustar) call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) @@ -3186,8 +3220,7 @@ subroutine get_forcing_groups(fluxes, water, heat, ustar, press, shelf, & ! to some degree. But since this would be enforced at the driver level, ! we handle them here as independent flags. - ustar = associated(fluxes%ustar) & - .and. associated(fluxes%ustar_gustless) + ustar = associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless) ! TODO: Check for all associated fields, but for now just check one as a marker water = associated(fluxes%evap) heat = associated(fluxes%seaice_melt_heat) @@ -3244,6 +3277,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%ustar)) deallocate(fluxes%ustar) if (associated(fluxes%ustar_gustless)) deallocate(fluxes%ustar_gustless) + if (associated(fluxes%tau_mag)) deallocate(fluxes%tau_mag) if (associated(fluxes%buoy)) deallocate(fluxes%buoy) if (associated(fluxes%sw)) deallocate(fluxes%sw) if (associated(fluxes%seaice_melt_heat)) deallocate(fluxes%seaice_melt_heat) @@ -3300,9 +3334,10 @@ end subroutine deallocate_forcing_type subroutine deallocate_mech_forcing(forces) type(mech_forcing), intent(inout) :: forces !< Forcing fields structure - if (associated(forces%taux)) deallocate(forces%taux) - if (associated(forces%tauy)) deallocate(forces%tauy) - if (associated(forces%ustar)) deallocate(forces%ustar) + if (associated(forces%taux)) deallocate(forces%taux) + if (associated(forces%tauy)) deallocate(forces%tauy) + if (associated(forces%ustar)) deallocate(forces%ustar) + if (associated(forces%tau_mag)) deallocate(forces%tau_mag) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) @@ -3331,6 +3366,7 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) if (do_ustar) then call rotate_array(fluxes_in%ustar, turns, fluxes%ustar) call rotate_array(fluxes_in%ustar_gustless, turns, fluxes%ustar_gustless) + call rotate_array(fluxes_in%tau_mag, turns, fluxes%tau_mag) endif if (do_water) then @@ -3461,8 +3497,10 @@ subroutine rotate_mech_forcing(forces_in, turns, forces) call rotate_vector(forces_in%taux, forces_in%tauy, turns, & forces%taux, forces%tauy) - if (do_ustar) & + if (do_ustar) then call rotate_array(forces_in%ustar, turns, forces%ustar) + call rotate_array(forces_in%tau_mag, turns, forces%tau_mag) + endif if (do_shelf) then call rotate_array_pair( & @@ -3521,24 +3559,27 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) do_press, do_iceberg) if (do_stress) then - tx_mean = global_area_mean_u(forces%taux, G, tmp_scale=US%Z_to_L*US%RL2_T2_to_Pa) + tx_mean = global_area_mean_u(forces%taux, G, tmp_scale=US%RLZ_T2_to_Pa) do j=js,je ; do i=isB,ieB if (G%mask2dCu(I,j) > 0.0) forces%taux(I,j) = tx_mean enddo ; enddo - ty_mean = global_area_mean_v(forces%tauy, G, tmp_scale=US%Z_to_L*US%RL2_T2_to_Pa) + ty_mean = global_area_mean_v(forces%tauy, G, tmp_scale=US%RLZ_T2_to_Pa) do j=jsB,jeB ; do i=is,ie if (G%mask2dCv(i,J) > 0.0) forces%tauy(i,J) = ty_mean enddo ; enddo if (tau2ustar) then - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j) > 0.0) forces%ustar(i,j) = sqrt(sqrt(tx_mean**2 + ty_mean**2)*Irho0) - enddo ; enddo + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + forces%tau_mag(i,j) = sqrt(tx_mean**2 + ty_mean**2) + forces%ustar(i,j) = sqrt(forces%tau_mag(i,j) * Irho0) + endif ; enddo ; enddo else call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) + call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) endif else if (do_ustar) then call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) + call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) endif endif @@ -3579,6 +3620,7 @@ subroutine homogenize_forcing(fluxes, G, GV, US) if (do_ustar) then call homogenize_field_t(fluxes%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) call homogenize_field_t(fluxes%ustar_gustless, G, tmp_scale=US%Z_to_m*US%s_to_T) + call homogenize_field_t(fluxes%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) endif if (do_water) then diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 7047dd6421..befeb1c2ad 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -3,40 +3,53 @@ module MOM_interface_heights ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_density_integrals, only : int_specific_vol_dp, avg_specific_vol use MOM_error_handler, only : MOM_error, FATAL +use MOM_EOS, only : calculate_density, EOS_type, EOS_domain use MOM_file_parser, only : log_version use MOM_grid, only : ocean_grid_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_density_integrals, only : int_specific_vol_dp implicit none ; private #include -public find_eta +public find_eta, dz_to_thickness, thickness_to_dz, dz_to_thickness_simple +public calc_derived_thermo !> Calculates the heights of the free surface or all interfaces from layer thicknesses. interface find_eta module procedure find_eta_2d, find_eta_3d end interface find_eta +!> Calculates layer thickness in thickness units from geometric distance between the +!! interfaces around that layer in height units. +interface dz_to_thickness + module procedure dz_to_thickness_tv, dz_to_thickness_EoS +end interface dz_to_thickness + +!> Converts layer thickness in thickness units into the vertical distance between the +!! interfaces around a layer in height units. +interface thickness_to_dz + module procedure thickness_to_dz_3d, thickness_to_dz_jslice +end interface thickness_to_dz + contains !> Calculates the heights of all interfaces between layers, using the appropriate !! form for consistency with the calculation of the pressure gradient forces. !! Additionally, these height may be dilated for consistency with the !! corresponding time-average quantity from the barotropic calculation. -subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref) +subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, dZref) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: eta !< layer interface heights - !! [Z ~> m] or [1/eta_to_m m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: eta !< layer interface heights [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable !! that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer @@ -44,8 +57,6 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref !! In Boussinesq mode, eta_bt and G%bathyT use the same reference height. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. - real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is US%Z_to_m. real, optional, intent(in) :: dZref !< The difference in the !! reference height between G%bathyT and eta [Z ~> m]. The default is 0. @@ -57,7 +68,6 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref real :: htot(SZI_(G)) ! total thickness [H ~> m or kg m-2] real :: I_gEarth ! The inverse of the gravitational acceleration times the ! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1] - real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. real :: dZ_ref ! The difference in the reference height between G%bathyT and eta [Z ~> m]. ! dZ_ref is 0 unless the optional argument dZref is present. integer i, j, k, isv, iev, jsv, jev, nz, halo @@ -70,20 +80,17 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref if ((isvG%ied) .or. (jsvG%jed)) & call MOM_error(FATAL,"find_eta called with an overly large halo_size.") - Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m - H_to_eta = GV%H_to_Z * Z_to_eta - H_to_rho_eta = GV%H_to_RZ * Z_to_eta - I_gEarth = Z_to_eta / GV%g_Earth + I_gEarth = 1.0 / GV%g_Earth dZ_ref = 0.0 ; if (present(dZref)) dZ_ref = dZref !$OMP parallel default(shared) private(dilate,htot) !$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -Z_to_eta*(G%bathyT(i,j) + dZ_ref) ; enddo ; enddo + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -(G%bathyT(i,j) + dZ_ref) ; enddo ; enddo if (GV%Boussinesq) then !$OMP do do j=jsv,jev ; do k=nz,1,-1 ; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*H_to_eta + eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo if (present(eta_bt)) then ! Dilate the water column to agree with the free surface height @@ -91,12 +98,12 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref !$OMP do do j=jsv,jev do i=isv,iev - dilate(i) = (eta_bt(i,j)*H_to_eta + Z_to_eta*G%bathyT(i,j)) / & - (eta(i,j,1) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) + dilate(i) = (eta_bt(i,j)*GV%H_to_Z + G%bathyT(i,j)) / & + (eta(i,j,1) + (G%bathyT(i,j) + dZ_ref)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) - & - Z_to_eta*(G%bathyT(i,j) + dZ_ref) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + (G%bathyT(i,j) + dZ_ref)) - & + (G%bathyT(i,j) + dZ_ref) enddo ; enddo enddo endif @@ -127,7 +134,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref else !$OMP do do j=jsv,jev ; do k=nz,1,-1 ; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) + eta(i,j,K) = eta(i,j,K+1) + GV%H_to_RZ*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -139,8 +146,8 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) - & - Z_to_eta*(G%bathyT(i,j) + dZ_ref) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + (G%bathyT(i,j) + dZ_ref)) - & + (G%bathyT(i,j) + dZ_ref) enddo ; enddo enddo endif @@ -153,7 +160,7 @@ end subroutine find_eta_3d !! with the calculation of the pressure gradient forces. Additionally, the sea !! surface height may be adjusted for consistency with the corresponding !! time-average quantity from the barotropic calculation. -subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref) +subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, dZref) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -168,8 +175,6 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref !! In Boussinesq mode, eta_bt and G%bathyT use the same reference height. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. - real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is US%Z_to_m. real, optional, intent(in) :: dZref !< The difference in the !! reference height between G%bathyT and eta [Z ~> m]. The default is 0. @@ -181,7 +186,6 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref real :: htot(SZI_(G)) ! The sum of all layers' thicknesses [H ~> m or kg m-2]. real :: I_gEarth ! The inverse of the gravitational acceleration times the ! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1] - real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. real :: dZ_ref ! The difference in the reference height between G%bathyT and eta [Z ~> m]. ! dZ_ref is 0 unless the optional argument dZref is present. integer i, j, k, is, ie, js, je, nz, halo @@ -190,26 +194,23 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = GV%ke - Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m - H_to_eta = GV%H_to_Z * Z_to_eta - H_to_rho_eta = GV%H_to_RZ * Z_to_eta - I_gEarth = Z_to_eta / GV%g_Earth + I_gEarth = 1.0 / GV%g_Earth dZ_ref = 0.0 ; if (present(dZref)) dZ_ref = dZref !$OMP parallel default(shared) private(htot) !$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -Z_to_eta*(G%bathyT(i,j) + dZ_ref) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta(i,j) = -(G%bathyT(i,j) + dZ_ref) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then !$OMP do do j=js,je ; do i=is,ie - eta(i,j) = H_to_eta*eta_bt(i,j) - Z_to_eta*dZ_ref + eta(i,j) = GV%H_to_Z*eta_bt(i,j) - dZ_ref enddo ; enddo else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + h(i,j,k)*H_to_eta + eta(i,j) = eta(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo endif else @@ -238,7 +239,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) + eta(i,j) = eta(i,j) + GV%H_to_RZ*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -249,8 +250,8 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) - & - Z_to_eta*(G%bathyT(i,j) + dZ_ref) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + (G%bathyT(i,j) + dZ_ref)) - & + (G%bathyT(i,j) + dZ_ref) enddo enddo endif @@ -259,4 +260,290 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref end subroutine find_eta_2d + +!> Calculate derived thermodynamic quantities for re-use later. +subroutine calc_derived_thermo(tv, h, G, GV, US, halo) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various + !! thermodynamic variables, some of + !! which will be set here. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + integer, optional, intent(in) :: halo !< Width of halo within which to + !! calculate thicknesses + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: p_t ! Hydrostatic pressure atop a layer [R L2 T-2 ~> Pa] + real, dimension(SZI_(G),SZJ_(G)) :: dp ! Pressure change across a layer [R L2 T-2 ~> Pa] + integer :: i, j, k, is, ie, js, je, halos, nz + + halos = 0 ; if (present(halo)) halos = max(0,halo) + is = G%isc-halos ; ie = G%iec+halos ; js = G%jsc-halos ; je = G%jec+halos ; nz = GV%ke + + if (allocated(tv%Spv_avg) .and. associated(tv%eqn_of_state)) then + if (associated(tv%p_surf)) then + do j=js,je ; do i=is,ie ; p_t(i,j) = tv%p_surf(i,j) ; enddo ; enddo + else + do j=js,je ; do i=is,ie ; p_t(i,j) = 0.0 ; enddo ; enddo + endif + do k=1,nz + do j=js,je ; do i=is,ie + dp(i,j) = GV%g_Earth*GV%H_to_RZ*h(i,j,k) + enddo ; enddo + call avg_specific_vol(tv%T(:,:,k), tv%S(:,:,k), p_t, dp, G%HI, tv%eqn_of_state, tv%SpV_avg(:,:,k), halo) + if (k Converts thickness from geometric height units to thickness units, perhaps via an +!! inversion of the integral of the density in pressure using variables stored in +!! the thermo_var_ptrs type when in non-Boussinesq mode. +subroutine dz_to_thickness_tv(dz, tv, h, G, GV, US, halo_size) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: dz !< Geometric layer thicknesses in height units [Z ~> m] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Output thicknesses in thickness units [H ~> m or kg m-2]. + !! This is essentially intent out, but declared as intent + !! inout to preserve any initialized values in halo points. + integer, optional, intent(in) :: halo_size !< Width of halo within which to + !! calculate thicknesses + ! Local variables + integer :: i, j, k, is, ie, js, je, halo, nz + + halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke + + if (GV%Boussinesq) then + do k=1,nz ; do j=js,je ; do i=is,ie + h(i,j,k) = GV%Z_to_H * dz(i,j,k) + enddo ; enddo ; enddo + else + if (associated(tv%eqn_of_state)) then + if (associated(tv%p_surf)) then + call dz_to_thickness_EOS(dz, tv%T, tv%S, tv%eqn_of_state, h, G, GV, US, halo, tv%p_surf) + else + call dz_to_thickness_EOS(dz, tv%T, tv%S, tv%eqn_of_state, h, G, GV, US, halo) + endif + else + do k=1,nz ; do j=js,je ; do i=is,ie + h(i,j,k) = (GV%Z_to_H*dz(i,j,k)) * (GV%Rlay(k) / GV%Rho0) + ! Consider revising this to the mathematically equivalent expression: + ! h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k) + enddo ; enddo ; enddo + endif + endif + +end subroutine dz_to_thickness_tv + +!> Converts thickness from geometric height units to thickness units, working via an +!! inversion of the integral of the density in pressure when in non-Boussinesq mode. +subroutine dz_to_thickness_EOS(dz, Temp, Saln, EoS, h, G, GV, US, halo_size, p_surf) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: dz !< Geometric layer thicknesses in height units [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: Temp !< Input layer temperatures [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: Saln !< Input layer salinities [S ~> ppt] + type(EOS_type), intent(in) :: EoS !< Equation of state structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Output thicknesses in thickness units [H ~> m or kg m-2]. + !! This is essentially intent out, but declared as intent + !! inout to preserve any initialized values in halo points. + integer, optional, intent(in) :: halo_size !< Width of halo within which to + !! calculate thicknesses + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: p_surf !< Surface pressures [R L2 T-2 ~> Pa] + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: & + p_top, p_bot ! Pressure at the interfaces above and below a layer [R L2 T-2 ~> Pa] + real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height across a layer [L2 T-2 ~> m2 s-2] + real :: rho(SZI_(G)) ! The in situ density [R ~> kg m-3] + real :: I_gEarth ! Unit conversion factors divided by the gravitational + ! acceleration [H T2 R-1 L-2 ~> s2 m2 kg-1 or s2 m-1] + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer :: i, j, k, is, ie, js, je, halo, nz + integer :: itt, max_itt + + halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke + max_itt = 10 + + if (GV%Boussinesq) then + do k=1,nz ; do j=js,je ; do i=is,ie + h(i,j,k) = GV%Z_to_H * dz(i,j,k) + enddo ; enddo ; enddo + else + I_gEarth = GV%RZ_to_H / GV%g_Earth + + if (present(p_surf)) then + do j=js,je ; do i=is,ie + p_bot(i,j) = 0.0 ; p_top(i,j) = p_surf(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + p_bot(i,j) = 0.0 ; p_top(i,j) = 0.0 + enddo ; enddo + endif + EOSdom(:) = EOS_domain(G%HI) + + ! The iterative approach here is inherited from very old code that was in the + ! MOM_state_initialization module. It does converge, but it is very inefficient and + ! should be revised, although doing so would change answers in non-Boussinesq mode. + do k=1,nz + do j=js,je + do i=is,ie ; p_top(i,j) = p_bot(i,j) ; enddo + call calculate_density(Temp(:,j,k), Saln(:,j,k), p_top(:,j), rho, & + EoS, EOSdom) + do i=is,ie + ! This could be simplified, but it would change answers at roundoff. + p_bot(i,j) = p_top(i,j) + (GV%g_Earth*GV%H_to_Z) * ((GV%Z_to_H*dz(i,j,k)) * rho(i)) + enddo + enddo + + do itt=1,max_itt + call int_specific_vol_dp(Temp(:,:,k), Saln(:,:,k), p_top, p_bot, 0.0, G%HI, & + EoS, US, dz_geo) + if (itt < max_itt) then ; do j=js,je + call calculate_density(Temp(:,j,k), Saln(:,j,k), p_bot(:,j), rho, & + EoS, EOSdom) + ! Use Newton's method to correct the bottom value. + ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. + do i=is,ie + p_bot(i,j) = p_bot(i,j) + rho(i) * ((GV%g_Earth*GV%H_to_Z)*(GV%Z_to_H*dz(i,j,k)) - dz_geo(i,j)) + enddo + enddo ; endif + enddo + + do j=js,je ; do i=is,ie + !### This code should be revised to use a dp variable for accuracy. + h(i,j,k) = (p_bot(i,j) - p_top(i,j)) * I_gEarth + enddo ; enddo + enddo + endif + +end subroutine dz_to_thickness_EOS + +!> Converts thickness from geometric height units to thickness units, perhaps using +!! a simple conversion factor that may be problematic in non-Boussinesq mode. +subroutine dz_to_thickness_simple(dz, h, G, GV, US, halo_size, layer_mode) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: dz !< Geometric layer thicknesses in height units [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Output thicknesses in thickness units [H ~> m or kg m-2]. + !! This is essentially intent out, but declared as intent + !! inout to preserve any initialized values in halo points. + integer, optional, intent(in) :: halo_size !< Width of halo within which to + !! calculate thicknesses + logical, optional, intent(in) :: layer_mode !< If present and true, do the conversion that + !! is appropriate in pure isopycnal layer mode with + !! no state variables or equation of state. Otherwise + !! use a simple constant rescaling factor and avoid the + !! use of GV%Rlay. + ! Local variables + logical :: layered ! If true and the model is non-Boussinesq, do calculations appropriate for use + ! in pure isopycnal layered mode with no state variables or equation of state. + integer :: i, j, k, is, ie, js, je, halo, nz + + halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) + layered = .false. ; if (present(layer_mode)) layered = layer_mode + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke + + if (GV%Boussinesq .or. (.not.layered)) then + do k=1,nz ; do j=js,je ; do i=is,ie + h(i,j,k) = GV%Z_to_H * dz(i,j,k) + enddo ; enddo ; enddo + elseif (layered) then + do k=1,nz ; do j=js,je ; do i=is,ie + h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k) + enddo ; enddo ; enddo + endif + +end subroutine dz_to_thickness_simple + +!> Converts layer thicknesses in thickness units to the vertical distance between edges in height +!! units, perhaps by multiplication by the precomputed layer-mean specific volume stored in an +!! array in the thermo_var_ptrs type when in non-Boussinesq mode. +subroutine thickness_to_dz_3d(h, tv, dz, G, GV, US, halo_size) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Input thicknesses in thickness units [H ~> m or kg m-2]. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: dz !< Geometric layer thicknesses in height units [Z ~> m] + !! This is essentially intent out, but declared as intent + !! inout to preserve any initialized values in halo points. + integer, optional, intent(in) :: halo_size !< Width of halo within which to + !! calculate thicknesses + ! Local variables + integer :: i, j, k, is, ie, js, je, halo, nz + + halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke + + if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then + do k=1,nz ; do j=js,je ; do i=is,ie + dz(i,j,k) = GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) + enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + dz(i,j,k) = GV%H_to_Z * h(i,j,k) + enddo ; enddo ; enddo + endif + +end subroutine thickness_to_dz_3d + + +!> Converts a vertical i- / k- slice of layer thicknesses in thickness units to the vertical +!! distance between edges in height units, perhaps by multiplication by the precomputed layer-mean +!! specific volume stored in an array in the thermo_var_ptrs type when in non-Boussinesq mode. +subroutine thickness_to_dz_jslice(h, tv, dz, j, G, GV, halo_size) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Input thicknesses in thickness units [H ~> m or kg m-2]. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, dimension(SZI_(G),SZK_(GV)), & + intent(inout) :: dz !< Geometric layer thicknesses in height units [Z ~> m] + !! This is essentially intent out, but declared as intent + !! inout to preserve any initialized values in halo points. + integer, intent(in) :: j !< The second (j-) index of the input thicknesses to work with + integer, optional, intent(in) :: halo_size !< Width of halo within which to + !! calculate thicknesses + ! Local variables + integer :: i, k, is, ie, halo, nz + + halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) + is = G%isc-halo ; ie = G%iec+halo ; nz = GV%ke + + if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then + do k=1,nz ; do i=is,ie + dz(i,k) = GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) + enddo ; enddo + else + do k=1,nz ; do i=is,ie + dz(i,k) = GV%H_to_Z * h(i,j,k) + enddo ; enddo + endif + +end subroutine thickness_to_dz_jslice + end module MOM_interface_heights diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 9bd292e796..ba8b8ce818 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -24,6 +24,7 @@ module MOM_open_boundary use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-) use MOM_tracer_registry, only : tracer_type, tracer_registry_type, tracer_name_lookup use MOM_interpolate, only : init_external_field, time_interp_external, time_interp_external_init +use MOM_interpolate, only : external_field use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme, remapping_CS use MOM_remapping, only : initialize_remapping, remapping_core_h, end_remapping use MOM_regridding, only : regridding_CS @@ -81,8 +82,9 @@ module MOM_open_boundary !> Open boundary segment data from files (mostly). type, public :: OBC_segment_data_type - integer :: fid !< handle from FMS associated with segment data on disk - integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk + type(external_field) :: handle !< handle from FMS associated with segment data on disk + type(external_field) :: dz_handle !< handle from FMS associated with segment thicknesses on disk + logical :: use_IO = .false. !< True if segment data is based on file input character(len=32) :: name !< a name identifier for the segment data character(len=8) :: genre !< an identifier for the segment data real :: scale !< A scaling factor for converting input data to @@ -96,7 +98,7 @@ module MOM_open_boundary real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid. !! The values for tracers should have the same units as the field !! they are being applied to? - real :: value !< constant value if fid is equal to -1 + real :: value !< constant value if not read from file real :: resrv_lfac_in = 1. !< reservoir inverse length scale factor for IN direction per field !< the general 1/Lscale_IN is multiplied by this factor for each tracer real :: resrv_lfac_out= 1. !< reservoir inverse length scale factor for OUT direction per field @@ -842,6 +844,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) ! The scale factor for tracers may also be set in register_segment_tracer, and a constant input ! value is rescaled there. segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US, segment%tr_Reg) + segment%field(m)%use_IO = .true. if (segment%field(m)%name == 'TEMP') then segment%temp_segment_data_exists = .true. segment%t_values_needed = .false. @@ -957,7 +960,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) endif endif segment%field(m)%buffer_src(:,:,:) = 0.0 - segment%field(m)%fid = init_external_field(trim(filename), trim(fieldname), & + segment%field(m)%handle = init_external_field(trim(filename), trim(fieldname), & ignore_axis_atts=.true., threading=SINGLE_FILE) if (siz(3) > 1) then if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then @@ -988,7 +991,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) endif segment%field(m)%dz_src(:,:,:)=0.0 segment%field(m)%nk_src=siz(3) - segment%field(m)%fid_dz = init_external_field(trim(filename), trim(fieldname), & + segment%field(m)%dz_handle = init_external_field(trim(filename), trim(fieldname), & ignore_axis_atts=.true., threading=SINGLE_FILE) endif else @@ -996,12 +999,12 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) endif endif else - segment%field(m)%fid = -1 segment%field(m)%name = trim(fields(m)) ! The scale factor for tracers may also be set in register_segment_tracer, and a constant input ! value is rescaled there. segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US, segment%tr_Reg) segment%field(m)%value = segment%field(m)%scale * value + segment%field(m)%use_IO = .false. ! Check if this is a tidal field. If so, the number ! of expected constituents must be 1. @@ -3892,7 +3895,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) !a less frequent update as set by the parameter update_OBC_period_max in MOM.F90. !Cycle if it is not the time to update OBC segment data for this field. if (trim(segment%field(m)%genre) == 'obgc' .and. (.not. OBC%update_OBC_seg_data)) cycle - if (segment%field(m)%fid > 0) then + if (segment%field(m)%use_IO) then siz(1)=size(segment%field(m)%buffer_src,1) siz(2)=size(segment%field(m)%buffer_src,2) siz(3)=size(segment%field(m)%buffer_src,3) @@ -3972,7 +3975,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif ! This is where the data values are actually read in. - call time_interp_external(segment%field(m)%fid, Time, tmp_buffer_in, scale=segment%field(m)%scale) + call time_interp_external(segment%field(m)%handle, Time, tmp_buffer_in, scale=segment%field(m)%scale) ! NOTE: Rotation of face-points require that we skip the final value if (turns /= 0) then @@ -4045,7 +4048,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (segment%field(m)%nk_src > 1 .and.& (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then ! This is where the 2-d tidal data values are actually read in. - call time_interp_external(segment%field(m)%fid_dz, Time, tmp_buffer_in, scale=US%m_to_Z) + call time_interp_external(segment%field(m)%dz_handle, Time, tmp_buffer_in, scale=US%m_to_Z) if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. if (segment%is_E_or_W & @@ -4211,7 +4214,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) deallocate(tmp_buffer) if (turns /= 0) & deallocate(tmp_buffer_in) - else ! fid <= 0 (Uniform value) + else ! use_IO = .false. (Uniform value) if (.not. allocated(segment%field(m)%buffer_dst)) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then @@ -4257,7 +4260,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do m = 1,segment%num_fields !cycle if it is not the time to update OBGC tracers from source if (trim(segment%field(m)%genre) == 'obgc' .and. (.not. OBC%update_OBC_seg_data)) cycle - ! if (segment%field(m)%fid>0) then + ! if (segment%field(m)%use_IO) then ! calculate external BT velocity and transport if needed if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then if (trim(segment%field(m)%name) == 'U' .and. segment%is_E_or_W) then @@ -4684,7 +4687,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & ! rescale the previously stored input values. Note that calls to register_segment_tracer ! can come before or after calls to initialize_segment_data. if (uppercase(segment%field(m)%name) == uppercase(segment%tr_Reg%Tr(ntseg)%name)) then - if (segment%field(m)%fid == -1) then + if (.not. segment%field(m)%use_IO) then rescale = scale if ((segment%field(m)%scale /= 0.0) .and. (segment%field(m)%scale /= 1.0)) & rescale = scale / segment%field(m)%scale @@ -5948,8 +5951,8 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns) segment%num_fields = segment_in%num_fields do n = 1, num_fields - segment%field(n)%fid = segment_in%field(n)%fid - segment%field(n)%fid_dz = segment_in%field(n)%fid_dz + segment%field(n)%handle = segment_in%field(n)%handle + segment%field(n)%dz_handle = segment_in%field(n)%dz_handle if (modulo(turns, 2) /= 0) then select case (segment_in%field(n)%name) diff --git a/src/core/MOM_unit_tests.F90 b/src/core/MOM_unit_tests.F90 index d13be05ffd..89383c4936 100644 --- a/src/core/MOM_unit_tests.F90 +++ b/src/core/MOM_unit_tests.F90 @@ -11,6 +11,8 @@ module MOM_unit_tests use MOM_random, only : random_unit_tests use MOM_hor_bnd_diffusion, only : near_boundary_unit_tests use MOM_CFC_cap, only : CFC_cap_unit_tests +use MOM_EOS, only : EOS_unit_tests +use MOM_mixed_layer_restrat, only : mixedlayer_restrat_unit_tests implicit none ; private public unit_tests @@ -30,6 +32,8 @@ subroutine unit_tests(verbosity) if (is_root_pe()) then ! The following need only be tested on 1 PE if (string_functions_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: string_functions_unit_tests FAILED") + if (EOS_unit_tests(verbose)) call MOM_error(FATAL, & + "MOM_unit_tests: EOS_unit_tests FAILED") if (remapping_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: remapping_unit_tests FAILED") if (neutral_diffusion_unit_tests(verbose)) call MOM_error(FATAL, & @@ -40,6 +44,8 @@ subroutine unit_tests(verbosity) "MOM_unit_tests: near_boundary_unit_tests FAILED") if (CFC_cap_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: CFC_cap_unit_tests FAILED") + if (mixedlayer_restrat_unit_tests(verbose)) call MOM_error(FATAL, & + "MOM_unit_tests: mixedlayer_restrat_unit_tests FAILED") endif end subroutine unit_tests diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index bf4b33af11..4ad26ed362 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -91,6 +91,9 @@ module MOM_variables logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is !! actually the absolute salinity in units of [gSalt kg-1]. real :: min_salinity !< The minimum value of salinity when BOUND_SALINITY=True [S ~> ppt]. + real, allocatable, dimension(:,:,:) :: SpV_avg + !< The layer averaged in situ specific volume [R-1 ~> m3 kg-1]. + ! These arrays are accumulated fluxes for communication with other components. real, dimension(:,:), pointer :: frazil => NULL() !< The energy needed to heat the ocean column to the @@ -255,8 +258,8 @@ module MOM_variables Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. ! The following elements are pointers so they can be used as targets for pointers in the restart registry. - real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. + real, pointer, dimension(:,:) :: MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. + real, pointer, dimension(:,:) :: sfc_buoy_flx => NULL() !< Surface buoyancy flux (derived) [Z2 T-3 ~> m2 s-3]. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers !! in tracer columns [Z2 T-1 ~> m2 s-1]. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index f20c7bbd26..5e9b5c476c 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -12,7 +12,7 @@ module MOM_verticalGrid #include public verticalGridInit, verticalGridEnd -public setVerticalGridAxes, fix_restart_scaling +public setVerticalGridAxes public get_flux_units, get_thickness_units, get_tr_flux_units ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional @@ -41,12 +41,18 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. + logical :: semi_Boussinesq !< If true, do non-Boussinesq pressure force calculations and + !! use mass-based "thicknesses, but use Rho0 to convert layer thicknesses + !! into certain height changes. This only applies if BOUSSINESQ is false. real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units [H ~> m or kg m-2]. real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units [Z ~> m]. real :: Angstrom_m !< A one-Angstrom thickness [m]. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level [H ~> m or kg m-2]. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. + real :: dZ_subroundoff !< A thickness in height units that is so small that it can be added to a + !! vertical distance of Angstrom_Z or 1e-17 m without changing it at the bit + !! level [Z ~> m]. This is the height equivalent of H_subroundoff. real, allocatable, dimension(:) :: & g_prime, & !< The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. Rlay !< The target coordinate value (potential density) in each layer [R ~> kg m-3]. @@ -74,8 +80,17 @@ module MOM_verticalGrid !! thickness units [H R-1 Z-1 ~> m3 kg-2 or 1]. real :: H_to_MKS !< A constant that translates thickness units to its MKS unit !! (m or kg m-2) based on GV%Boussinesq [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] + real :: m2_s_to_HZ_T !< The combination of conversion factors that converts kinematic viscosities + !! in m2 s-1 to the internal units of the kinematic (in Boussinesq mode) + !! or dynamic viscosity [H Z s T-1 m-2 ~> 1 or kg m-3] + real :: HZ_T_to_m2_s !< The combination of conversion factors that converts the viscosities from + !! their internal representation into a kinematic viscosity in m2 s-1 + !! [T m2 H-1 Z-1 s-1 ~> 1 or m3 kg-1] + real :: HZ_T_to_MKS !< The combination of conversion factors that converts the viscosities from + !! their internal representation into their unnscaled MKS units + !! (m2 s-1 or Pa s), depending on whether the model is Boussinesq + !! [T m2 H-1 Z-1 s-1 ~> 1] or [T Pa s H-1 Z-1 ~> 1] - real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type contains @@ -91,6 +106,8 @@ subroutine verticalGridInit( param_file, GV, US ) ! Local variables integer :: nk, H_power real :: H_rescale_factor ! The integer power of 2 by which thicknesses are rescaled [nondim] + real :: rho_Kv ! The density used convert input kinematic viscosities into dynamic viscosities + ! when in non-Boussinesq mode [R ~> kg m-3] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' @@ -114,6 +131,17 @@ subroutine verticalGridInit( param_file, GV, US ) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) + call get_param(param_file, mdl, "SEMI_BOUSSINESQ", GV%semi_Boussinesq, & + "If true, do non-Boussinesq pressure force calculations and use mass-based "//& + "thicknesses, but use RHO_0 to convert layer thicknesses into certain "//& + "height changes. This only applies if BOUSSINESQ is false.", & + default=.true., do_not_log=GV%Boussinesq) + if (GV%Boussinesq) GV%semi_Boussinesq = .true. + call get_param(param_file, mdl, "RHO_KV_CONVERT", Rho_Kv, & + "The density used to convert input kinematic viscosities into dynamic "//& + "viscosities in non-BOUSSINESQ mode, and similarly for vertical diffusivities.", & + units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, & + do_not_log=GV%Boussinesq) call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_Z, & "The minimum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10, scale=US%m_to_Z) @@ -156,26 +184,41 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_kg_m2 = US%R_to_kg_m3*GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m - GV%Angstrom_H = GV%m_to_H * US%Z_to_m*GV%Angstrom_Z GV%H_to_MKS = GV%H_to_m + GV%m2_s_to_HZ_T = GV%m_to_H * US%m_to_Z * US%T_to_s else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H GV%H_to_m = GV%H_to_kg_m2 / (US%R_to_kg_m3*GV%Rho0) - GV%Angstrom_H = US%Z_to_m*GV%Angstrom_Z * 1000.0*GV%kg_m2_to_H GV%H_to_MKS = GV%H_to_kg_m2 + GV%m2_s_to_HZ_T = US%R_to_kg_m3*rho_Kv * GV%kg_m2_to_H * US%m_to_Z * US%T_to_s endif - GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H + + GV%Angstrom_H = GV%Z_to_H * GV%Angstrom_Z GV%Angstrom_m = US%Z_to_m * GV%Angstrom_Z + GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H, GV%m_to_H*1e-17) + GV%dZ_subroundoff = 1e-20 * max(GV%Angstrom_Z, US%m_to_Z*1e-17) + + GV%H_to_Pa = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth * GV%H_to_kg_m2 + GV%H_to_RZ = GV%H_to_kg_m2 * US%kg_m3_to_R * US%m_to_Z GV%RZ_to_H = GV%kg_m2_to_H * US%R_to_kg_m3 * US%Z_to_m -! Log derivative values. + GV%HZ_T_to_m2_s = 1.0 / GV%m2_s_to_HZ_T + GV%HZ_T_to_MKS = GV%H_to_MKS * US%Z_to_m * US%s_to_T + + ! Note based on the above that for both Boussinsq and non-Boussinesq cases that: + ! GV%Rho0 = GV%Z_to_H * GV%H_to_RZ + ! 1.0/GV%Rho0 = GV%H_to_Z * GV%RZ_to_H + ! This is exact for power-of-2 scaling of the units, regardless of the value of Rho0, but + ! the first term on the right hand side is invertable in Boussinesq mode, but the second + ! is invertable when non-Boussinesq. + + ! Log derivative values. call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor, units="H m-1") call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H, units="2^n H m-1") call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m, units="2^-n m H-1") @@ -187,20 +230,6 @@ subroutine verticalGridInit( param_file, GV, US ) end subroutine verticalGridInit -!> Set the scaling factors for restart files to the scaling factors for this run. -subroutine fix_restart_scaling(GV, unscaled) - type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure - logical, optional, intent(in) :: unscaled !< If true, set the restart factors as though the - !! model would be unscaled, which is appropriate if the - !! scaling is undone when writing a restart file. - - GV%m_to_H_restart = GV%m_to_H - if (present(unscaled)) then ; if (unscaled) then - GV%m_to_H_restart = 1.0 - endif ; endif - -end subroutine fix_restart_scaling - !> Returns the model's thickness units, usually m or kg/m^2. function get_thickness_units(GV) character(len=48) :: get_thickness_units !< The vertical thickness units diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ff65a3b60b..cf8b042c14 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -324,12 +324,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! mass per area of grid cell (for Boussinesq, use Rho0) if (CS%id_masscello > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2*h(i,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_masscello, work_3d, CS%diag) - !### If the registration call has conversion=GV%H_to_kg_m2, the mathematically equivalent form would be: - ! call post_data(CS%id_masscello, h, CS%diag) + call post_data(CS%id_masscello, h, CS%diag) endif ! mass of liquid ocean (for Bouss, use Rho0). The reproducing sum requires the use of MKS units. @@ -635,7 +630,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_rhopot0 > 0) call post_data(CS%id_rhopot0, Rcv, CS%diag) endif if (CS%id_rhopot2 > 0) then - pressure_1d(:) = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 ! 2000 dbars + pressure_1d(:) = 2.0e7*US%Pa_to_RL2_T2 ! 2000 dbars !$OMP parallel do default(shared) do k=1,nz ; do j=js,je call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & @@ -1638,7 +1633,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag convert_H = GV%H_to_MKS CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL, & - Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & !### , conversion=GV%H_to_kg_m2, & + Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', conversion=GV%H_to_kg_m2, & standard_name='sea_water_mass_per_unit_area', v_extensive=.true.) CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 1f1a8e0d36..d6a337b08a 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -56,6 +56,7 @@ subroutine find_obsolete_params(param_file) hint="Instead use OBC_SEGMENT_xxx_VELOCITY_NUDGING_TIMESCALES.") enddo + call obsolete_logical(param_file, "CONVERT_THICKNESS_UNITS", .true.) call obsolete_logical(param_file, "MASK_MASSLESS_TRACERS", .false.) call obsolete_logical(param_file, "SALT_REJECT_BELOW_ML", .false.) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 9c8cd099f3..bb1b381c15 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -7,7 +7,7 @@ module MOM_wave_speed use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : log_version use MOM_grid, only : ocean_grid_type -use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h, interpolate_column use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -651,17 +651,33 @@ subroutine tdma6(n, a, c, lam, y) end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. -subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - integer, intent(in) :: nmodes !< Number of modes - real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] - type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct - logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire data domain. +subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_struct_max, u_struct_bot, Nb, int_w2, & + int_U2, int_N2w2, full_halos) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + integer, intent(in) :: nmodes !< Number of modes + type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1,nmodes),intent(out) :: w_struct !< Wave Vertical profile [nondim] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV),nmodes),intent(out) :: u_struct !< Wave Horizontal profile [Z-1 ~> m-1] + real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: u_struct_max !< Maximum of wave horizontal profile + !! [Z-1 ~> m-1] + real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: u_struct_bot !< Bottom value of wave horizontal + !! profile [Z-1 ~> m-1] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Nb !< Bottom value of Brunt Vaissalla freqency + !! [T-1 ~> s-1] + real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_w2 !< depth-integrated + !! vertical profile squared [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_U2 !< depth-integrated + !! horizontal profile squared [Z-1 ~> m-1] + real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_N2w2 !< depth-integrated Brunt Vaissalla + !! frequency times vertical + !! profile squared [Z T-2 ~> m s-2] + logical, optional, intent(in) :: full_halos !< If true, do the calculation + !! over the entire data domain. ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -672,7 +688,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) S_int, & ! Salinity interpolated to interfaces [S ~> ppt] H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m] H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m] - gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. + gprime, & ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. + N2 ! The Brunt Vaissalla freqency squared [T-2 ~> s-2] real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] Tf, & ! Layer temperatures after very thin layers are combined [C ~> degC] @@ -684,7 +701,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) Hc, & ! A column of layer thicknesses after convective instabilities are removed [Z ~> m] Tc, & ! A column of layer temperatures after convective instabilities are removed [C ~> degC] Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt] - Rc ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] + Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] + Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and its ! derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. @@ -737,7 +755,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real :: tol_merge ! The fractional change in estimated wave speed that is allowed ! when deciding to merge layers in the calculation [nondim] integer :: kf(SZI_(G)) ! The number of active layers after filtering. - integer, parameter :: max_itt = 10 + integer, parameter :: max_itt = 30 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. logical :: better_est ! If true, use an improved estimate of the first mode internal wave speed. logical :: merge ! If true, merge the current layer with the one above. @@ -749,6 +767,21 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: kc ! The number of layers in the column after merging integer :: sub, sub_it integer :: i, j, k, k2, itt, is, ie, js, je, nz, iint, m + real, dimension(SZK_(GV)+1) :: modal_structure !< Normalized model structure [nondim] + real, dimension(SZK_(GV)) :: modal_structure_fder !< Normalized model structure [Z-1 ~> m-1] + real :: mode_struct(SZK_(GV)+1) ! The mode structure [nondim], but it is also temporarily + ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6. + real :: mode_struct_fder(SZK_(GV)) ! The mode structure 1st derivative [nondim], but it is also temporarily + ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6. + real :: mode_struct_sq(SZK_(GV)+1) ! The square of mode structure [nondim] + real :: mode_struct_fder_sq(SZK_(GV)) ! The square of mode structure 1st derivative [Z-2 ~> m-2] + + + real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2] + real :: ms_sq ! The sum of the square of the values returned from tdma6 [L4 T-4 ~> m4 s-4] + real :: w2avg ! A total for renormalization + real, parameter :: a_int = 0.5 ! Integral total for normalization + real :: renorm ! Normalization factor is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -777,9 +810,17 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) endif cg1_min2 = CS%min_speed2 - ! Zero out all wave speeds. Values over land or for columns that are too weakly stratified + ! Zero out all local values. Values over land or for columns that are too weakly stratified ! are not changed from this zero value. cn(:,:,:) = 0.0 + u_struct_max(:,:,:) = 0.0 + u_struct_bot(:,:,:) = 0.0 + Nb(:,:) = 0.0 + int_w2(:,:,:) = 0.0 + int_N2w2(:,:,:) = 0.0 + int_U2(:,:,:) = 0.0 + u_struct(:,:,:,:) = 0.0 + w_struct(:,:,:,:) = 0.0 min_h_frac = tol_Hfrac / real(nz) !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,CS,min_h_frac,use_EOS, & @@ -1010,8 +1051,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Calculate Igu, Igl, depth, and N2 at each interior interface ! [excludes surface (K=1) and bottom (K=kc+1)] + Igl(:) = 0. + Igu(:) = 0. + N2(:) = 0. + do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) + N2(K) = US%L_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) if (better_est) then speed2_tot = speed2_tot + gprime(K)*((H_top(K) * H_bot(K)) * I_Htot) else @@ -1019,9 +1065,21 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) endif enddo + ! Set stratification for surface and bottom (setting equal to nearest interface for now) + N2(1) = N2(2) ; N2(kc+1) = N2(kc) + ! set bottom stratification + Nb(i,j) = sqrt(N2(kc+1)) + ! Under estimate the first eigenvalue (overestimate the speed) to start with. lam_1 = 1.0 / speed2_tot + ! init and first guess for mode structure + mode_struct(:) = 0. + mode_struct_fder(:) = 0. + mode_struct(2:kc) = 1. ! Uniform flow, first guess + modal_structure(:) = 0. + modal_structure_fder(:) = 0. + ! Find the first eigen value do itt=1,max_itt ! calculate the determinant of (A-lam_1*I) @@ -1039,11 +1097,89 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) lam_1 = lam_1 + dlam endif + call tdma6(kc-1, Igu(2:kc), Igl(2:kc), lam_1, mode_struct(2:kc)) + ! Note that tdma6 changes the units of mode_struct to [L2 T-2 ~> m2 s-2] + ! apply BC + mode_struct(1) = 0. + mode_struct(kc+1) = 0. + + ! renormalization of the integral of the profile + w2avg = 0.0 + do k=1,kc + w2avg = w2avg + 0.5*(mode_struct(K)**2+mode_struct(K+1)**2)*Hc(k) ![Z L4 T-4] + enddo + renorm = sqrt(htot(i)*a_int/w2avg) ![L-2 T-2] + do K=1,kc+1 ; mode_struct(K) = renorm * mode_struct(K) ; enddo + ! after renorm, mode_struct is again [nondim] + if (abs(dlam) < tol_solve*lam_1) exit enddo if (lam_1 > 0.0) cn(i,j,1) = 1.0 / sqrt(lam_1) + ! sign of wave structure is irrelevant, flip to positive if needed + if (mode_struct(2)<0.) then + mode_struct(2:kc) = -1. * mode_struct(2:kc) + endif + + ! vertical derivative of w at interfaces lives on the layer points + do k=1,kc + mode_struct_fder(k) = (mode_struct(k) - mode_struct(k+1)) / Hc(k) + enddo + + ! boundary condition for derivative is no-gradient + do k=kc+1,nz + mode_struct_fder(k) = mode_struct_fder(kc) + enddo + + ! now save maximum value and bottom value + u_struct_bot(i,j,1) = mode_struct_fder(kc) + u_struct_max(i,j,1) = maxval(abs(mode_struct_fder(1:kc))) + + ! Calculate terms for vertically integrated energy equation + do k=1,kc + mode_struct_fder_sq(k) = mode_struct_fder(k)**2 + enddo + do K=1,kc+1 + mode_struct_sq(K) = mode_struct(K)**2 + enddo + + ! sum over layers for quantities defined on layer + do k=1,kc + int_U2(i,j,1) = int_U2(i,j,1) + mode_struct_fder_sq(k) * Hc(k) + enddo + + ! vertical integration with Trapezoidal rule for values at interfaces + do K=1,kc + int_w2(i,j,1) = int_w2(i,j,1) + 0.5*(mode_struct_sq(K)+mode_struct_sq(K+1)) * Hc(k) + int_N2w2(i,j,1) = int_N2w2(i,j,1) + 0.5*(mode_struct_sq(K)*N2(K) + & + mode_struct_sq(K+1)*N2(K+1)) * Hc(k) + enddo + + ! Note that remapping_core_h requires that the same units be used + ! for both the source and target grid thicknesses, here [H ~> m or kg m-2]. + do k = 1,kc + Hc_H(k) = GV%Z_to_H * Hc(k) + enddo + + ! for w (diag) interpolate onto all interfaces + call interpolate_column(kc, Hc_H(1:kc), mode_struct(1:kc+1), & + nz, h(i,j,:), modal_structure(:), .false.) + + ! for u (remap) onto all layers + call remapping_core_h(CS%remapping_CS, kc, Hc_H(1:kc), mode_struct_fder(1:kc), & + nz, h(i,j,:), modal_structure_fder(:), & + GV%H_subroundoff, GV%H_subroundoff) + + ! write the wave structure + do k=1,nz+1 + w_struct(i,j,k,1) = modal_structure(k) + enddo + + do k=1,nz + u_struct(i,j,k,1) = modal_structure_fder(k) + enddo + ! Find other eigen values if c1 is of significant magnitude, > cn_thresh nrootsfound = 0 ! number of extra roots found (not including 1st root) if ((nmodes > 1) .and. (kc >= nmodes+1) .and. (cn(i,j,1) > CS%c1_thresh)) then @@ -1128,16 +1264,105 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Use Newton's method to find the roots within the identified windows do m=1,nrootsfound ! loop over the root-containing widows (excluding 1st mode) lam_n = xbl(m) ! first guess is left edge of window + + ! init and first guess for mode structure + mode_struct(:) = 0. + mode_struct_fder(:) = 0. + mode_struct(2:kc) = 1. ! Uniform flow, first guess + modal_structure(:) = 0. + modal_structure_fder(:) = 0. + do itt=1,max_itt ! calculate the determinant of (A-lam_n*I) call tridiag_det(Igu, Igl, 2, kc, lam_n, det, ddet, row_scale=c2_scale) ! Use Newton's method to find a new estimate of lam_n dlam = - det / ddet lam_n = lam_n + dlam + + call tdma6(kc-1, Igu(2:kc), Igl(2:kc), lam_n, mode_struct(2:kc)) + ! Note that tdma6 changes the units of mode_struct to [L2 T-2 ~> m2 s-2] + ! apply BC + mode_struct(1) = 0. + mode_struct(kc+1) = 0. + + ! renormalization of the integral of the profile + w2avg = 0.0 + do k=1,kc + w2avg = w2avg + 0.5*(mode_struct(K)**2+mode_struct(K+1)**2)*Hc(k) + enddo + renorm = sqrt(htot(i)*a_int/w2avg) + do K=1,kc+1 ; mode_struct(K) = renorm * mode_struct(K) ; enddo + if (abs(dlam) < tol_solve*lam_1) exit enddo ! itt-loop + ! calculate nth mode speed if (lam_n > 0.0) cn(i,j,m+1) = 1.0 / sqrt(lam_n) + + ! sign is irrelevant, flip to positive if needed + if (mode_struct(2)<0.) then + mode_struct(2:kc) = -1. * mode_struct(2:kc) + endif + + ! derivative of vertical profile (i.e. dw/dz) is evaluated at the layer point + do k=1,kc + mode_struct_fder(k) = (mode_struct(k) - mode_struct(k+1)) / Hc(k) + enddo + + ! boundary condition for 1st derivative is no-gradient + do k=kc+1,nz + mode_struct_fder(k) = mode_struct_fder(kc) + enddo + + ! now save maximum value and bottom value + u_struct_bot(i,j,m) = mode_struct_fder(kc) + u_struct_max(i,j,m) = maxval(abs(mode_struct_fder(1:kc))) + + ! Calculate terms for vertically integrated energy equation + do k=1,kc + mode_struct_fder_sq(k) = mode_struct_fder(k)**2 + enddo + do K=1,kc+1 + mode_struct_sq(K) = mode_struct(K)**2 + enddo + + ! sum over layers for integral of quantities defined at layer points + do k=1,kc + int_U2(i,j,m) = int_U2(i,j,m) + mode_struct_fder_sq(k) * Hc(k) + enddo + + ! vertical integration with Trapezoidal rule for quantities on interfaces + do K=1,kc + int_w2(i,j,m) = int_w2(i,j,m) + 0.5*(mode_struct_sq(K)+mode_struct_sq(K+1)) * Hc(k) + int_N2w2(i,j,m) = int_N2w2(i,j,m) + 0.5*(mode_struct_sq(K)*N2(K) + & + mode_struct_sq(K+1)*N2(K+1)) * Hc(k) + enddo + + ! Note that remapping_core_h requires that the same units be used + ! for both the source and target grid thicknesses, here [H ~> m or kg m-2]. + do k = 1,kc + Hc_H(k) = GV%Z_to_H * Hc(k) + enddo + + ! for w (diag) interpolate onto all interfaces + call interpolate_column(kc, Hc_H(1:kc), mode_struct(1:kc+1), & + nz, h(i,j,:), modal_structure(:), .false.) + + ! for u (remap) onto all layers + call remapping_core_h(CS%remapping_CS, kc, Hc_H(1:kc), mode_struct_fder(1:kc), & + nz, h(i,j,:), modal_structure_fder(:), & + GV%H_subroundoff, GV%H_subroundoff) + + ! write the wave structure + ! note that m=1 solves for 2nd mode,... + do k=1,nz+1 + w_struct(i,j,k,m+1) = modal_structure(k) + enddo + + do k=1,nz + u_struct(i,j,k,m+1) = modal_structure_fder(k) + enddo + enddo ! n-loop endif ! if nmodes>1 .and. kc>nmodes .and. c1>c1_thresh endif ! if more than 2 layers diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 deleted file mode 100644 index 80d23eeb75..0000000000 --- a/src/diagnostics/MOM_wave_structure.F90 +++ /dev/null @@ -1,793 +0,0 @@ -!> Vertical structure functions for first baroclinic mode wave speed -module MOM_wave_structure - -! This file is part of MOM6. See LICENSE.md for the license. - -! By Benjamin Mater & Robert Hallberg, 2015 - -! The subroutine in this module calculates the vertical structure -! functions of the first baroclinic mode internal wave speed. -! Calculation of interface values is the same as done in -! MOM_wave_speed by Hallberg, 2008. - -use MOM_debugging, only : isnan => is_NaN -use MOM_checksums, only : chksum0, hchksum -use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl -use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type -use MOM_EOS, only : calculate_density_derivs -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : log_version, param_file_type, get_param -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use regrid_solvers, only : solve_diag_dominant_tridiag - -implicit none ; private - -#include - -public wave_structure, wave_structure_init - -! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional -! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units -! vary with the Boussinesq approximation, the Boussinesq variant is given first. - -!> The control structure for the MOM_wave_structure module -type, public :: wave_structure_CS ; !private - logical :: initialized = .false. !< True if this control structure has been initialized. - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to - !! regulate the timing of diagnostic output. - real, allocatable, dimension(:,:,:) :: w_strct - !< Vertical structure of vertical velocity (normalized) [nondim]. - real, allocatable, dimension(:,:,:) :: u_strct - !< Vertical structure of horizontal velocity (normalized and - !! divided by layer thicknesses) [Z-1 ~> m-1]. - real, allocatable, dimension(:,:,:) :: W_profile - !< Vertical profile of w_hat(z), where - !! w(x,y,z,t) = w_hat(z)*exp(i(kx+ly-freq*t)) is the full time- - !! varying vertical velocity with w_hat(z) = W0*w_strct(z) [Z T-1 ~> m s-1]. - real, allocatable, dimension(:,:,:) :: Uavg_profile - !< Vertical profile of the magnitude of horizontal velocity, - !! (u^2+v^2)^0.5, averaged over a period [L T-1 ~> m s-1]. - real, allocatable, dimension(:,:,:) :: z_depths - !< Depths of layer interfaces [Z ~> m]. - real, allocatable, dimension(:,:,:) :: N2 - !< Squared buoyancy frequency at each interface [T-2 ~> s-2]. - integer, allocatable, dimension(:,:):: num_intfaces - !< Number of layer interfaces (including surface and bottom) [nondim]. - ! logical :: int_tide_source_test !< If true, apply an arbitrary generation site for internal tide testing - ! integer :: int_tide_source_i !< I Location of generation site - ! integer :: int_tide_source_j !< J Location of generation site - logical :: debug !< debugging prints - -end type wave_structure_CS - -contains - -!> This subroutine determines the internal wave velocity structure for any mode. -!! -!! This subroutine solves for the eigen vector [vertical structure, e(k)] associated with -!! the first baroclinic mode speed [i.e., smallest eigen value (lam = 1/c^2)] of the -!! system d2e/dz2 = -(N2/cn2)e, or (A-lam*I)e = 0, where A = -(1/N2)(d2/dz2), lam = 1/c^2, -!! and I is the identity matrix. 2nd order discretization in the vertical lets this system -!! be represented as -!! -!! -Igu(k)*e(k-1) + (Igu(k)+Igl(k)-lam)*e(k) - Igl(k)*e(k+1) = 0.0 -!! -!! with rigid lid boundary conditions e(1) = e(nz+1) = 0.0 giving -!! -!! (Igu(2)+Igl(2)-lam)*e(2) - Igl(2)*e(3) = 0.0 -!! -Igu(nz)*e(nz-1) + (Igu(nz)+Igl(nz)-lam)*e(nz) = 0.0 -!! -!! where, upon noting N2 = reduced gravity/layer thickness, we get -!! Igl(k) = 1.0/(gprime(k)*H(k)) ; Igu(k) = 1.0/(gprime(k)*H(k-1)) -!! -!! The eigen value for this system is approximated using "wave_speed." This subroutine uses -!! these eigen values (mode speeds) to estimate the corresponding eigen vectors (velocity -!! structure) using the "inverse iteration with shift" method. The algorithm is -!! -!! Pick a starting vector reasonably close to mode structure and with unit magnitude, b_guess -!! For n=1,2,3,... -!! Solve (A-lam*I)e = e_guess for e -!! Set e_guess=e/|e| and repeat, with each iteration refining the estimate of e -subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halos) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal - !! gravity wave speed [L T-1 ~> m s-1]. - integer, intent(in) :: ModeNum !< Mode number - real, intent(in) :: freq !< Intrinsic wave frequency [T-1 ~> s-1]. - type(wave_structure_CS), intent(inout) :: CS !< Wave structure control struct - real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: En !< Internal wave energy density [R Z3 T-2 ~> J m-2] - logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational domain. - ! Local variables - real, dimension(SZK_(GV)+1) :: & - dRho_dT, & !< Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] - dRho_dS, & !< Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] - pres, & !< Interface pressure [R L2 T-2 ~> Pa] - T_int, & !< Temperature interpolated to interfaces [C ~> degC] - S_int, & !< Salinity interpolated to interfaces [S ~> ppt] - gprime !< The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. - real, dimension(SZK_(GV)) :: & - Igl, Igu !< The inverse of the reduced gravity across an interface times - !< the thickness of the layer below (Igl) or above (Igu) it [T2 L-2 ~> s2 m-2]. - real, dimension(SZK_(GV),SZI_(G)) :: & - Hf, & !< Layer thicknesses after very thin layers are combined [Z ~> m] - Tf, & !< Layer temperatures after very thin layers are combined [C ~> degC] - Sf, & !< Layer salinities after very thin layers are combined [S ~> ppt] - Rf !< Layer densities after very thin layers are combined [R ~> kg m-3] - real, dimension(SZK_(GV)) :: & - Hc, & !< A column of layer thicknesses after convective instabilities are removed [Z ~> m] - Tc, & !< A column of layer temperatures after convective instabilities are removed [C ~> degC] - Sc, & !< A column of layer salinities after convective instabilities are removed [S ~> ppt] - Rc !< A column of layer densities after convective instabilities are removed [R ~> kg m-3] - real, dimension(SZI_(G),SZJ_(G)) :: & - htot !< The vertical sum of the thicknesses [Z ~> m] - real :: lam !< inverse of wave speed squared [T2 L-2 ~> s2 m-2] - real :: min_h_frac !< fractional (per layer) minimum thickness [nondim] - real :: Z_to_pres !< A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] - real, dimension(SZI_(G)) :: & - hmin, & !< Thicknesses [Z ~> m] - H_here, & !< A thickness [Z ~> m] - HxT_here, & !< A layer integrated temperature [C Z ~> degC m] - HxS_here, & !< A layer integrated salinity [S Z ~> ppt m] - HxR_here !< A layer integrated density [R Z ~> kg m-2] - real :: I_Hnew !< The inverse of a new layer thickness [Z-1 ~> m-1] - real :: drxh_sum !< The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real, parameter :: tol1 = 0.0001, tol2 = 0.001 ! Nondimensional tolerances [nondim] - real :: g_Rho0 !< G_Earth/Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. - ! real :: rescale, I_rescale - integer :: kf(SZI_(G)) - integer, parameter :: max_itt = 1 !< number of times to iterate in solving for eigenvector - real :: cg_subRO !< A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] - real, parameter :: a_int = 0.5 !< value of normalized integral: \int(w_strct^2)dz = a_int [nondim] - real :: I_a_int !< inverse of a_int [nondim] - real :: f2 !< squared Coriolis frequency [T-2 ~> s-2] - real :: Kmag2 !< magnitude of horizontal wave number squared [L-2 ~> m-2] - real :: emag2 ! The sum of the squared magnitudes of the guesses [nondim] - real :: pi_htot ! The gravest vertical wavenumber in this column [Z-1 ~> m-1] - real :: renorm ! A renormalization factor [nondim] - logical :: use_EOS !< If true, density is calculated from T & S using an - !! equation of state. - - ! local representations of variables in CS; note, - ! not all rows will be filled if layers get merged! - real, dimension(SZK_(GV)+1) :: w_strct !< Vertical structure of vertical velocity (normalized) [nondim]. - real, dimension(SZK_(GV)+1) :: u_strct !< Vertical structure of horizontal velocity (normalized and - !! divided by layer thicknesses) [Z-1 ~> m-1]. - real, dimension(SZK_(GV)+1) :: W_profile !< Vertical profile of w_hat(z) = W0*w_strct(z) [Z T-1 ~> m s-1]. - real, dimension(SZK_(GV)+1) :: Uavg_profile !< Vertical profile of the magnitude of - !! horizontal velocity [L T-1 ~> m s-1]. - real, dimension(SZK_(GV)+1) :: z_int !< Integrated depth [Z ~> m] - real, dimension(SZK_(GV)+1) :: N2 !< Squared buoyancy frequency at each interface [T-2 ~> s-2]. - real, dimension(SZK_(GV)+1) :: w_strct2 !< squared values [nondim] - real, dimension(SZK_(GV)+1) :: u_strct2 !< squared values [Z-2 ~> m-2] - real, dimension(SZK_(GV)) :: dz !< thicknesses of merged layers (same as Hc I hope) [Z ~> m] - ! real, dimension(SZK_(GV)+1) :: dWdz_profile !< profile of dW/dz times total depth [Z T-1 ~> m s-1] - real :: w2avg !< average of squared vertical velocity structure function [Z ~> m] - real :: int_dwdz2 !< Vertical integral of the square of u_strct [Z-1 ~> m-1] - real :: int_w2 !< Vertical integral of the square of w_strct [Z ~> m] - real :: int_N2w2 !< Vertical integral of N2 [Z T-2 ~> m s-2] - real :: KE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] - real :: PE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] - real :: W0 !< A vertical velocity magnitude [Z T-1 ~> m s-1] - real :: U_mag !< A horizontal velocity magnitude times the depth of the - !! ocean [Z L T-1 ~> m2 s-1] - real, dimension(SZK_(GV)-1) :: lam_z !< product of eigen value and gprime(k); one value for each - !< interface (excluding surface and bottom) [Z-1 ~> m-1] - real, dimension(SZK_(GV)-1) :: a_diag !< upper diagonal of tridiagonal matrix; one value for each - !< interface (excluding surface and bottom) [Z-1 ~> m-1] - real, dimension(SZK_(GV)-1) :: c_diag !< lower diagonal of tridiagonal matrix; one value for each - !< interface (excluding surface and bottom) [Z-1 ~> m-1] - real, dimension(SZK_(GV)-1) :: b_dom !< Matrix center diagonal offset from a_diag + c_diag; one value - !< for each interface (excluding surface and bottom) [Z-1 ~> m-1] - real, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitude (for TDMA) [nondim] - real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) [nondim] - real :: Pi ! 3.1415926535... [nondim] - integer :: i, j, k, k2, kc, itt, is, ie, js, je, nz, nzm, row, ig, jg, ig_stop, jg_stop - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - I_a_int = 1/a_int - - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_structure: "// & - "Module must be initialized before it is used.") - - if (present(full_halos)) then ; if (full_halos) then - is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed - endif ; endif - - Pi = (4.0*atan(1.0)) - - g_Rho0 = GV%g_Earth / GV%Rho0 - - !if (CS%debug) call chksum0(g_Rho0, "g/rho0 in wave struct", & - ! scale=(US%L_to_m**2)*US%m_to_Z*(US%s_to_T**2)*US%kg_m3_to_R) - - if (CS%debug) call chksum0(freq, "freq in wave_struct", scale=US%s_to_T) - - cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. - use_EOS = associated(tv%eqn_of_state) - - ! Simplifying the following could change answers at roundoff. - Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) - ! rescale = 1024.0**4 ; I_rescale = 1.0/rescale - - min_h_frac = tol1 / real(nz) - - do j=js,je - ! First merge very thin layers with the one above (or below if they are - ! at the top). This also transposes the row order so that columns can - ! be worked upon one at a time. - do i=is,ie ; htot(i,j) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo - - do i=is,ie - hmin(i) = htot(i,j)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 - HxT_here(i) = 0.0 ; HxS_here(i) = 0.0 ; HxR_here(i) = 0.0 - enddo - if (use_EOS) then - do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then - Hf(kf(i),i) = H_here(i) - Tf(kf(i),i) = HxT_here(i) / H_here(i) - Sf(kf(i),i) = HxS_here(i) / H_here(i) - kf(i) = kf(i) + 1 - - ! Start a new layer - H_here(i) = h(i,j,k)*GV%H_to_Z - HxT_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) - HxS_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) - else - H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxT_here(i) = HxT_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) - endif - enddo ; enddo - do i=is,ie ; if (H_here(i) > 0.0) then - Hf(kf(i),i) = H_here(i) - Tf(kf(i),i) = HxT_here(i) / H_here(i) - Sf(kf(i),i) = HxS_here(i) / H_here(i) - endif ; enddo - else - do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then - Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) - kf(i) = kf(i) + 1 - - ! Start a new layer - H_here(i) = h(i,j,k)*GV%H_to_Z - HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) - else - H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) - endif - enddo ; enddo - do i=is,ie ; if (H_here(i) > 0.0) then - Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) - endif ; enddo - endif ! use_EOS? - - ! From this point, we can work on individual columns without causing memory - ! to have page faults. - do i=is,ie ; if (cn(i,j) > 0.0) then - !----for debugging, remove later---- - ig = i + G%idg_offset ; jg = j + G%jdg_offset - !if (ig == CS%int_tide_source_i .and. jg == CS%int_tide_source_j) then - !----------------------------------- - if (G%mask2dT(i,j) > 0.0) then - - gprime(:) = 0.0 ! init gprime - pres(:) = 0.0 ! init pres - lam = 1/(cn(i,j)**2) - - ! Calculate drxh_sum - if (use_EOS) then - pres(1) = 0.0 - do k=2,kf(i) - pres(k) = pres(k-1) + Z_to_pres*Hf(k-1,i) - T_int(k) = 0.5*(Tf(k,i)+Tf(k-1,i)) - S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) - enddo - call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & - tv%eqn_of_state, (/2,kf(i)/) ) - - ! Sum the reduced gravities to find out how small a density difference - ! is negligibly small. - drxh_sum = 0.0 - do k=2,kf(i) - drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * & - max(0.0,dRho_dT(k)*(Tf(k,i)-Tf(k-1,i)) + & - dRho_dS(k)*(Sf(k,i)-Sf(k-1,i))) - enddo - else - drxh_sum = 0.0 - do k=2,kf(i) - drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * & - max(0.0,Rf(k,i)-Rf(k-1,i)) - enddo - endif ! use_EOS? - - ! Find gprime across each internal interface, taking care of convective - ! instabilities by merging layers. - if (drxh_sum >= 0.0) then - ! Merge layers to eliminate convective instabilities or exceedingly - ! small reduced gravities. - if (use_EOS) then - kc = 1 - Hc(1) = Hf(1,i) ; Tc(1) = Tf(1,i) ; Sc(1) = Sf(1,i) - do k=2,kf(i) - if ((dRho_dT(k)*(Tf(k,i)-Tc(kc)) + dRho_dS(k)*(Sf(k,i)-Sc(kc))) * & - (Hc(kc) + Hf(k,i)) < 2.0 * tol2*drxh_sum) then - ! Merge this layer with the one above and backtrack. - I_Hnew = 1.0 / (Hc(kc) + Hf(k,i)) - Tc(kc) = (Hc(kc)*Tc(kc) + Hf(k,i)*Tf(k,i)) * I_Hnew - Sc(kc) = (Hc(kc)*Sc(kc) + Hf(k,i)*Sf(k,i)) * I_Hnew - Hc(kc) = (Hc(kc) + Hf(k,i)) - ! Backtrack to remove any convective instabilities above... Note - ! that the tolerance is a factor of two larger, to avoid limit how - ! far back we go. - do k2=kc,2,-1 - if ((dRho_dT(k2)*(Tc(k2)-Tc(k2-1)) + dRho_dS(k2)*(Sc(k2)-Sc(k2-1))) * & - (Hc(k2) + Hc(k2-1)) < tol2*drxh_sum) then - ! Merge the two bottommost layers. At this point kc = k2. - I_Hnew = 1.0 / (Hc(kc) + Hc(kc-1)) - Tc(kc-1) = (Hc(kc)*Tc(kc) + Hc(kc-1)*Tc(kc-1)) * I_Hnew - Sc(kc-1) = (Hc(kc)*Sc(kc) + Hc(kc-1)*Sc(kc-1)) * I_Hnew - Hc(kc-1) = (Hc(kc) + Hc(kc-1)) - kc = kc - 1 - else ; exit ; endif - enddo - else - ! Add a new layer to the column. - kc = kc + 1 - drho_dS(kc) = drho_dS(k) ; drho_dT(kc) = drho_dT(k) - Tc(kc) = Tf(k,i) ; Sc(kc) = Sf(k,i) ; Hc(kc) = Hf(k,i) - endif - enddo - ! At this point there are kc layers and the gprimes should be positive. - do k=2,kc ! Revisit this if non-Boussinesq. - gprime(k) = g_Rho0 * (dRho_dT(k)*(Tc(k)-Tc(k-1)) + & - dRho_dS(k)*(Sc(k)-Sc(k-1))) - enddo - else ! .not.use_EOS - ! Do the same with density directly... - kc = 1 - Hc(1) = Hf(1,i) ; Rc(1) = Rf(1,i) - do k=2,kf(i) - if ((Rf(k,i) - Rc(kc)) * (Hc(kc) + Hf(k,i)) < 2.0*tol2*drxh_sum) then - ! Merge this layer with the one above and backtrack. - Rc(kc) = (Hc(kc)*Rc(kc) + Hf(k,i)*Rf(k,i)) / (Hc(kc) + Hf(k,i)) - Hc(kc) = (Hc(kc) + Hf(k,i)) - ! Backtrack to remove any convective instabilities above... Note - ! that the tolerance is a factor of two larger, to avoid limit how - ! far back we go. - do k2=kc,2,-1 - if ((Rc(k2)-Rc(k2-1)) * (Hc(k2)+Hc(k2-1)) < tol2*drxh_sum) then - ! Merge the two bottommost layers. At this point kc = k2. - Rc(kc-1) = (Hc(kc)*Rc(kc) + Hc(kc-1)*Rc(kc-1)) / (Hc(kc) + Hc(kc-1)) - Hc(kc-1) = (Hc(kc) + Hc(kc-1)) - kc = kc - 1 - else ; exit ; endif - enddo - else - ! Add a new layer to the column. - kc = kc + 1 - Rc(kc) = Rf(k,i) ; Hc(kc) = Hf(k,i) - endif - enddo - ! At this point there are kc layers and the gprimes should be positive. - do k=2,kc ! Revisit this if non-Boussinesq. - gprime(k) = g_Rho0 * (Rc(k)-Rc(k-1)) - enddo - endif ! use_EOS? - - !-----------------NOW FIND WAVE STRUCTURE------------------------------------- - ! Construct and solve tridiagonal system for the interior interfaces - ! Note that kc = number of layers, - ! kc+1 = nzm = number of interfaces, - ! kc-1 = number of interior interfaces (excluding surface and bottom) - ! Also, note that "K" refers to an interface, while "k" refers to the layer below. - ! Need at least 3 layers (2 internal interfaces) to generate a matrix, also - ! need number of layers to be greater than the mode number - if (kc >= max(3, ModeNum + 1)) then - ! Set depth at surface - z_int(1) = 0.0 - ! Calculate Igu, Igl, depth, and N2 at each interior interface - ! [excludes surface (K=1) and bottom (K=kc+1)] - do K=2,kc - Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) - z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = US%L_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) - enddo - ! Set stratification for surface and bottom (setting equal to nearest interface for now) - N2(1) = N2(2) ; N2(kc+1) = N2(kc) - ! Calcualte depth at bottom - z_int(kc+1) = z_int(kc)+Hc(kc) - ! check that thicknesses sum to total depth - if (abs(z_int(kc+1)-htot(i,j)) > 1.e-14*htot(i,j)) then - call MOM_error(FATAL, "wave_structure: mismatch in total depths") - endif - - ! Populate interior rows of tridiagonal matrix; must multiply through by - ! gprime to get tridiagonal matrix to the symmetrical form: - ! [-1/H(k-1)]e(k-1) + [1/H(k-1)+1/H(k)-lam_z]e(k) + [-1/H(k)]e(k+1) = 0, - ! where lam_z = lam*gprime is now a function of depth. - ! First, populate interior rows - - ! init the values in matrix: since number of layers is variable, values need to be reset - lam_z(:) = 0.0 - a_diag(:) = 0.0 - b_dom(:) = 0.0 - c_diag(:) = 0.0 - e_guess(:) = 0.0 - e_itt(:) = 0.0 - w_strct(:) = 0.0 - do K=3,kc-1 - row = K-1 ! indexing for TD matrix rows - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_dom(row) = 2.0*gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) - enddo - if (CS%debug) then ; do row=2,kc-2 - if (isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif - if (isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif - if (isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif - enddo ; endif - ! Populate top row of tridiagonal matrix - K=2 ; row = K-1 ; - lam_z(row) = lam*gprime(K) - a_diag(row) = 0.0 - b_dom(row) = gprime(K)*(Igu(K)+2.0*Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) - ! Populate bottom row of tridiagonal matrix - K=kc ; row = K-1 - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_dom(row) = gprime(K)*(2.0*Igu(K) + Igl(K)) - lam_z(row) - c_diag(row) = 0.0 - - ! Guess a normalized vector shape to start with (excludes surface and bottom) - emag2 = 0.0 - pi_htot = Pi / htot(i,j) - do K=2,kc - e_guess(K-1) = sin(pi_htot * z_int(K)) - emag2 = emag2 + e_guess(K-1)**2 - enddo - renorm = 1.0 / sqrt(emag2) - do K=2,kc ; e_guess(K-1) = renorm*e_guess(K-1) ; enddo - - ! Perform inverse iteration with tri-diag solver - do itt=1,max_itt - ! this solver becomes unstable very quickly - ! b_diag(1:kc-1) = b_dom(1:kc-1) - (a_diag(1:kc-1) + c_diag(1:kc-1)) - !call tridiag_solver(a_diag(1:kc-1),b_diag(1:kc-1),c_diag(1:kc-1), & - ! -lam_z(1:kc-1),e_guess(1:kc-1),"TDMA_T",e_itt) - - call solve_diag_dominant_tridiag( c_diag, b_dom, a_diag, e_guess, e_itt, kc-1 ) - ! Renormalize the guesses of the structure.- - emag2 = 0.0 - do K=2,kc ; emag2 = emag2 + e_itt(K-1)**2 ; enddo - renorm = 1.0 / sqrt(emag2) - do K=2,kc ; e_guess(K-1) = renorm*e_itt(K-1) ; enddo - - ! A test should be added here to evaluate convergence. - enddo ! itt-loop - do K=2,kc ; w_strct(K) = e_guess(K-1) ; enddo - w_strct(1) = 0.0 ! rigid lid at surface - w_strct(kc+1) = 0.0 ! zero-flux at bottom - - ! Check to see if solver worked - if (CS%debug) then - ig_stop = 0 ; jg_stop = 0 - if (isnan(sum(w_strct(1:kc+1)))) then - print *, "Wave_structure: w_strct has a NAN at ig=", ig, ", jg=", jg - if (iG%iec .or. jG%jec)then - print *, "This is occuring at a halo point." - endif - ig_stop = ig ; jg_stop = jg - endif - endif - - ! Normalize vertical structure function of w such that - ! \int(w_strct)^2dz = a_int (a_int could be any value, e.g., 0.5) - nzm = kc+1 ! number of layer interfaces after merging - !(including surface and bottom) - w2avg = 0.0 - do k=1,nzm-1 - dz(k) = Hc(k) - w2avg = w2avg + 0.5*(w_strct(K)**2+w_strct(K+1)**2)*dz(k) - enddo - ! correct renormalization: - renorm = sqrt(htot(i,j)*a_int/w2avg) - do K=1,kc+1 ; w_strct(K) = renorm * w_strct(K) ; enddo - - ! Calculate vertical structure function of u (i.e. dw/dz) - do K=2,nzm-1 - u_strct(K) = 0.5*((w_strct(K-1) - w_strct(K) )/dz(k-1) + & - (w_strct(K) - w_strct(K+1))/dz(k)) - enddo - u_strct(1) = (w_strct(1) - w_strct(2) )/dz(1) - u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) - - ! Calculate wavenumber magnitude - f2 = (0.25*(G%CoriolisBu(I,J) + G%CoriolisBu(max(I-1,1),max(J-1,1)) + & - G%CoriolisBu(I,max(J-1,1)) + G%CoriolisBu(max(I-1,1),J)))**2 - Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) - - ! Calculate terms in vertically integrated energy equation - int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 - do K=1,nzm - u_strct2(K) = u_strct(K)**2 - w_strct2(K) = w_strct(K)**2 - enddo - ! vertical integration with Trapezoidal rule - do k=1,nzm-1 - int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1)) * dz(k) - int_w2 = int_w2 + 0.5*(w_strct2(K)+w_strct2(K+1)) * dz(k) - int_N2w2 = int_N2w2 + 0.5*(w_strct2(K)*N2(K)+w_strct2(K+1)*N2(K+1)) * dz(k) - enddo - - ! Back-calculate amplitude from energy equation - if (present(En) .and. (freq**2*Kmag2 > 0.0)) then - ! Units here are [R Z ~> kg m-2] - KE_term = 0.25*GV%Rho0*( ((freq**2 + f2) / (freq**2*Kmag2))*US%L_to_Z**2*int_dwdz2 + int_w2 ) - PE_term = 0.25*GV%Rho0*( int_N2w2 / freq**2 ) - if (En(i,j) >= 0.0) then - W0 = sqrt( En(i,j) / (KE_term + PE_term) ) - else - call MOM_error(WARNING, "wave_structure: En < 0.0; setting to W0 to 0.0") - print *, "En(i,j)=", En(i,j), " at ig=", ig, ", jg=", jg - W0 = 0.0 - endif - ! Calculate actual vertical velocity profile and derivative - U_mag = W0 * sqrt((freq**2 + f2) / (2.0*freq**2*Kmag2)) - do K=1,nzm - W_profile(K) = W0*w_strct(K) - ! dWdz_profile(K) = W0*u_strct(K) - ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile(K) = abs(U_mag * u_strct(K)) - enddo - else - do K=1,nzm - W_profile(K) = 0.0 - ! dWdz_profile(K) = 0.0 - Uavg_profile(K) = 0.0 - enddo - endif - - ! Store values in control structure - do K=1,nzm - CS%w_strct(i,j,K) = w_strct(K) - CS%u_strct(i,j,K) = u_strct(K) - CS%W_profile(i,j,K) = W_profile(K) - CS%Uavg_profile(i,j,K) = Uavg_profile(K) - CS%z_depths(i,j,K) = z_int(K) - CS%N2(i,j,K) = N2(K) - enddo - CS%num_intfaces(i,j) = nzm - else - ! If not enough layers, default to zero - nzm = kc+1 - do K=1,nzm - CS%w_strct(i,j,K) = 0.0 - CS%u_strct(i,j,K) = 0.0 - CS%W_profile(i,j,K) = 0.0 - CS%Uavg_profile(i,j,K) = 0.0 - CS%z_depths(i,j,K) = 0.0 ! could use actual values - CS%N2(i,j,K) = 0.0 ! could use with actual values - enddo - CS%num_intfaces(i,j) = nzm - endif ! kc >= 3 and kc > ModeNum + 1? - endif ! drxh_sum >= 0? - !else ! if at test point - delete later - ! return ! if at test point - delete later - !endif ! if at test point - delete later - endif ! mask2dT > 0.0? - else - ! if cn=0.0, default to zero - nzm = nz+1 ! could use actual values - do K=1,nzm - CS%w_strct(i,j,K) = 0.0 - CS%u_strct(i,j,K) = 0.0 - CS%W_profile(i,j,K) = 0.0 - CS%Uavg_profile(i,j,K) = 0.0 - CS%z_depths(i,j,K) = 0.0 ! could use actual values - CS%N2(i,j,K) = 0.0 ! could use with actual values - enddo - CS%num_intfaces(i,j) = nzm - endif ; enddo ! if cn>0.0? ; i-loop - enddo ! j-loop - - if (CS%debug) call hchksum(CS%N2, 'N2 in wave_struct', G%HI, scale=US%s_to_T**2) - if (CS%debug) call hchksum(cn, 'cn in wave_struct', G%HI, scale=US%L_T_to_m_s) - if (CS%debug) call hchksum(CS%W_profile, 'Wprofile in wave_struct', G%HI, scale=US%Z_to_L*US%L_T_to_m_s) - if (CS%debug) call hchksum(CS%Uavg_profile, 'Uavg_profile in wave_struct', G%HI, scale=US%L_T_to_m_s) - -end subroutine wave_structure - -! The subroutine tridiag_solver is never used and could perhaps be deleted. - -!> Solves a tri-diagonal system Ax=y using either the standard -!! Thomas algorithm (TDMA_T) or its more stable variant that invokes the -!! "Hallberg substitution" (TDMA_H). -subroutine tridiag_solver(a, b, c, h, y, method, x) - real, dimension(:), intent(in) :: a !< lower diagonal with first entry equal to zero. - real, dimension(:), intent(in) :: b !< middle diagonal. - real, dimension(:), intent(in) :: c !< upper diagonal with last entry equal to zero. - real, dimension(:), intent(in) :: h !< vector of values that have already been added to b; used - !! for systems of the form (e.g. average layer thickness in vertical diffusion case): - !! [ -alpha(k-1/2) ] * e(k-1) + - !! [ alpha(k-1/2) + alpha(k+1/2) + h(k) ] * e(k) + - !! [ -alpha(k+1/2) ] * e(k+1) = y(k) - !! where a(k)=[-alpha(k-1/2)], b(k)=[alpha(k-1/2)+alpha(k+1/2) + h(k)], - !! and c(k)=[-alpha(k+1/2)]. Only used with TDMA_H method. - real, dimension(:), intent(in) :: y !< vector of known values on right hand side. - character(len=*), intent(in) :: method !< A string describing the algorithm to use - real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. - ! Local variables - integer :: nrow ! number of rows in A matrix -! real, allocatable, dimension(:,:) :: A_check ! for solution checking -! real, allocatable, dimension(:) :: y_check ! for solution checking - real, allocatable, dimension(:) :: c_prime, y_prime, q, alpha - ! intermediate values for solvers - real :: Q_prime, beta ! intermediate values for solver - integer :: k ! row (e.g. interface) index - - nrow = size(y) - allocate(c_prime(nrow)) - allocate(y_prime(nrow)) - allocate(q(nrow)) - allocate(alpha(nrow)) -! allocate(A_check(nrow,nrow)) -! allocate(y_check(nrow)) - - if (method == 'TDMA_T') then - ! Standard Thomas algoritim (4th variant). - ! Note: Requires A to be non-singular for accuracy/stability - c_prime(:) = 0.0 ; y_prime(:) = 0.0 - c_prime(1) = c(1)/b(1) ; y_prime(1) = y(1)/b(1) - - ! Forward sweep - do k=2,nrow-1 - c_prime(k) = c(k)/(b(k)-a(k)*c_prime(k-1)) - enddo - !print *, 'c_prime=', c_prime(1:nrow) - do k=2,nrow - y_prime(k) = (y(k)-a(k)*y_prime(k-1))/(b(k)-a(k)*c_prime(k-1)) - enddo - !print *, 'y_prime=', y_prime(1:nrow) - x(nrow) = y_prime(nrow) - - ! Backward sweep - do k=nrow-1,1,-1 - x(k) = y_prime(k)-c_prime(k)*x(k+1) - enddo - !print *, 'x=',x(1:nrow) - - ! Check results - delete later - !do j=1,nrow ; do i=1,nrow - ! if (i==j)then ; A_check(i,j) = b(i) - ! elseif (i==j+1)then ; A_check(i,j) = a(i) - ! elseif (i==j-1)then ; A_check(i,j) = c(i) - ! endif - !enddo ; enddo - !print *, 'A(2,1),A(2,2),A(1,2)=', A_check(2,1), A_check(2,2), A_check(1,2) - !y_check = matmul(A_check,x) - !if (all(y_check /= y))then - ! print *, "tridiag_solver: Uh oh, something's not right!" - ! print *, "y=", y - ! print *, "y_check=", y_check - !endif - - elseif (method == 'TDMA_H') then - ! Thomas algoritim (4th variant) w/ Hallberg substitution. - ! For a layered system where k is at interfaces, alpha{k+1/2} refers to - ! some property (e.g. inverse thickness for mode-structure problem) of the - ! layer below and alpha{k-1/2} refers to the layer above. - ! Here, alpha(k)=alpha{k+1/2} and alpha(k-1)=alpha{k-1/2}. - ! Strictly speaking, this formulation requires A to be a non-singular, - ! symmetric, diagonally dominant matrix, with h>0. - ! Need to add a check for these conditions. - do k=1,nrow-1 - if (abs(a(k+1)-c(k)) > 1.e-10*(abs(a(k+1))+abs(c(k)))) then - call MOM_error(FATAL, "tridiag_solver: matrix not symmetric; need symmetry when invoking TDMA_H") - endif - enddo - alpha = -c - ! Alpha of the bottom-most layer is not necessarily zero. Therefore, - ! back out the value from the provided b(nrow and h(nrow) values - alpha(nrow) = b(nrow)-h(nrow)-alpha(nrow-1) - ! Prime other variables - beta = 1/b(1) - y_prime(:) = 0.0 ; q(:) = 0.0 - y_prime(1) = beta*y(1) ; q(1) = beta*alpha(1) - Q_prime = 1-q(1) - - ! Forward sweep - do k=2,nrow-1 - beta = 1/(h(k)+alpha(k-1)*Q_prime+alpha(k)) - if (isnan(beta))then ; print *, "Tridiag_solver: beta is NAN" ; endif - q(k) = beta*alpha(k) - y_prime(k) = beta*(y(k)+alpha(k-1)*y_prime(k-1)) - Q_prime = beta*(h(k)+alpha(k-1)*Q_prime) - enddo - if ((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then - call MOM_error(FATAL, "Tridiag_solver: this system is not stable.") ! ; overriding beta(nrow) - ! This has hard-coded dimensions: beta = 1/(1e-15) ! place holder for unstable systems - delete later - else - beta = 1/(h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) - endif - y_prime(nrow) = beta*(y(nrow)+alpha(nrow-1)*y_prime(nrow-1)) - x(nrow) = y_prime(nrow) - ! Backward sweep - do k=nrow-1,1,-1 - x(k) = y_prime(k)+q(k)*x(k+1) - enddo - !print *, 'yprime=',y_prime(1:nrow) - !print *, 'x=',x(1:nrow) - endif - - deallocate(c_prime,y_prime,q,alpha) -! deallocate(A_check,y_check) - -end subroutine tridiag_solver - -!> Allocate memory associated with the wave structure module and read parameters. -subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) - type(time_type), intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time - !! parameters. - type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate - !! diagnostic output. - type(wave_structure_CS), intent(inout) :: CS !< Wave structure control struct - - ! This include declares and sets the variable "version". -# include "version_variable.h" - character(len=40) :: mdl = "MOM_wave_structure" ! This module's name. - integer :: isd, ied, jsd, jed, nz - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - - CS%initialized = .true. - - ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & - ! "If true, apply an arbitrary generation site for internal tide testing", & - ! default=.false.) - ! if (CS%int_tide_source_test) then - ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_I", CS%int_tide_source_i, & - ! "I Location of generation site for internal tide", default=0) - ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_J", CS%int_tide_source_j, & - ! "J Location of generation site for internal tide", default=0) - ! endif - call get_param(param_file, mdl, "DEBUG", CS%debug, & - "debugging prints", default=.false.) - - CS%diag => diag - - ! Allocate memory for variable in control structure; note, - ! not all rows will be filled if layers get merged! - allocate(CS%w_strct(isd:ied,jsd:jed,nz+1)) - allocate(CS%u_strct(isd:ied,jsd:jed,nz+1)) - allocate(CS%W_profile(isd:ied,jsd:jed,nz+1)) - allocate(CS%Uavg_profile(isd:ied,jsd:jed,nz+1)) - allocate(CS%z_depths(isd:ied,jsd:jed,nz+1)) - allocate(CS%N2(isd:ied,jsd:jed,nz+1)) - allocate(CS%num_intfaces(isd:ied,jsd:jed)) - - ! Write all relevant parameters to the model log. - call log_version(param_file, mdl, version, "") - -end subroutine wave_structure_init - -end module MOM_wave_structure diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 4ddedf85a8..c68dc7b661 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -6,44 +6,70 @@ module MOM_EOS use MOM_EOS_linear, only : calculate_density_linear, calculate_spec_vol_linear use MOM_EOS_linear, only : calculate_density_derivs_linear use MOM_EOS_linear, only : calculate_specvol_derivs_linear, int_density_dz_linear -use MOM_EOS_linear, only : calculate_density_second_derivs_linear +use MOM_EOS_linear, only : calculate_density_second_derivs_linear, EoS_fit_range_linear use MOM_EOS_linear, only : calculate_compress_linear, int_spec_vol_dp_linear +use MOM_EOS_linear, only : avg_spec_vol_linear use MOM_EOS_Wright, only : calculate_density_wright, calculate_spec_vol_wright use MOM_EOS_Wright, only : calculate_density_derivs_wright use MOM_EOS_Wright, only : calculate_specvol_derivs_wright, int_density_dz_wright use MOM_EOS_Wright, only : calculate_compress_wright, int_spec_vol_dp_wright -use MOM_EOS_Wright, only : calculate_density_second_derivs_wright +use MOM_EOS_Wright, only : calculate_density_second_derivs_wright, calc_density_second_derivs_wright_buggy +use MOM_EOS_Wright, only : EoS_fit_range_Wright, avg_spec_vol_Wright +use MOM_EOS_Wright_full, only : calculate_density_wright_full, calculate_spec_vol_wright_full +use MOM_EOS_Wright_full, only : calculate_density_derivs_wright_full +use MOM_EOS_Wright_full, only : calculate_specvol_derivs_wright_full, int_density_dz_wright_full +use MOM_EOS_Wright_full, only : calculate_compress_wright_full, int_spec_vol_dp_wright_full +use MOM_EOS_Wright_full, only : calculate_density_second_derivs_wright_full +use MOM_EOS_Wright_full, only : EoS_fit_range_Wright_full, avg_spec_vol_Wright_full +use MOM_EOS_Wright_red, only : calculate_density_wright_red, calculate_spec_vol_wright_red +use MOM_EOS_Wright_red, only : calculate_density_derivs_wright_red +use MOM_EOS_Wright_red, only : calculate_specvol_derivs_wright_red, int_density_dz_wright_red +use MOM_EOS_Wright_red, only : calculate_compress_wright_red, int_spec_vol_dp_wright_red +use MOM_EOS_Wright_red, only : calculate_density_second_derivs_wright_red +use MOM_EOS_Wright_red, only : EoS_fit_range_Wright_red, avg_spec_vol_Wright_red +use MOM_EOS_Jackett06, only : calculate_density_Jackett06, calculate_spec_vol_Jackett06 +use MOM_EOS_Jackett06, only : calculate_density_derivs_Jackett06, calculate_specvol_derivs_Jackett06 +use MOM_EOS_Jackett06, only : calculate_compress_Jackett06, calculate_density_second_derivs_Jackett06 +use MOM_EOS_Jackett06, only : EoS_fit_range_Jackett06 use MOM_EOS_UNESCO, only : calculate_density_unesco, calculate_spec_vol_unesco -use MOM_EOS_UNESCO, only : calculate_density_derivs_unesco, calculate_density_unesco -use MOM_EOS_UNESCO, only : calculate_compress_unesco -use MOM_EOS_NEMO, only : calculate_density_nemo -use MOM_EOS_NEMO, only : calculate_density_derivs_nemo, calculate_density_nemo -use MOM_EOS_NEMO, only : calculate_compress_nemo +use MOM_EOS_UNESCO, only : calculate_density_derivs_unesco, calculate_specvol_derivs_UNESCO +use MOM_EOS_UNESCO, only : calculate_density_second_derivs_UNESCO, calculate_compress_unesco +use MOM_EOS_UNESCO, only : EoS_fit_range_UNESCO +use MOM_EOS_Roquet_rho, only : calculate_density_Roquet_rho +use MOM_EOS_Roquet_rho, only : calculate_density_derivs_Roquet_rho +use MOM_EOS_Roquet_rho, only : calculate_density_second_derivs_Roquet_rho, calculate_compress_Roquet_rho +use MOM_EOS_Roquet_rho, only : EoS_fit_range_Roquet_rho +use MOM_EOS_Roquet_SpV, only : calculate_density_Roquet_SpV, calculate_spec_vol_Roquet_SpV +use MOM_EOS_Roquet_SpV, only : calculate_density_derivs_Roquet_SpV, calculate_specvol_derivs_Roquet_SpV +use MOM_EOS_Roquet_SpV, only : calculate_compress_Roquet_SpV, calculate_density_second_derivs_Roquet_SpV +use MOM_EOS_Roquet_SpV, only : EoS_fit_range_Roquet_SpV use MOM_EOS_TEOS10, only : calculate_density_teos10, calculate_spec_vol_teos10 -use MOM_EOS_TEOS10, only : calculate_density_derivs_teos10 -use MOM_EOS_TEOS10, only : calculate_specvol_derivs_teos10 -use MOM_EOS_TEOS10, only : calculate_density_second_derivs_teos10 -use MOM_EOS_TEOS10, only : calculate_compress_teos10 +use MOM_EOS_TEOS10, only : calculate_density_derivs_teos10, calculate_specvol_derivs_teos10 +use MOM_EOS_TEOS10, only : calculate_density_second_derivs_teos10, calculate_compress_teos10 +use MOM_EOS_TEOS10, only : EoS_fit_range_TEOS10 use MOM_EOS_TEOS10, only : gsw_sp_from_sr, gsw_pt_from_ct +use MOM_temperature_convert, only : poTemp_to_consTemp, consTemp_to_poTemp use MOM_TFreeze, only : calculate_TFreeze_linear, calculate_TFreeze_Millero -use MOM_TFreeze, only : calculate_TFreeze_teos10 +use MOM_TFreeze, only : calculate_TFreeze_teos10, calculate_TFreeze_TEOS_poly use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type +use MOM_io, only : stdout use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type implicit none ; private -#include - public EOS_domain public EOS_init public EOS_manual_init public EOS_quadrature public EOS_use_linear +public EOS_fit_range +public EOS_unit_tests public analytic_int_density_dz public analytic_int_specific_vol_dp +public average_specific_vol public calculate_compress public calculate_density public calculate_density_derivs @@ -67,16 +93,14 @@ module MOM_EOS !> Calculates density of sea water from T, S and P interface calculate_density module procedure calculate_density_scalar - module procedure calculate_density_array module procedure calculate_density_1d module procedure calculate_stanley_density_scalar - module procedure calculate_stanley_density_array module procedure calculate_stanley_density_1d end interface calculate_density !> Calculates specific volume of sea water from T, S and P interface calculate_spec_vol - module procedure calc_spec_vol_scalar, calculate_spec_vol_array + module procedure calc_spec_vol_scalar module procedure calc_spec_vol_1d end interface calculate_spec_vol @@ -88,7 +112,7 @@ module MOM_EOS !> Calculate the derivatives of specific volume with temperature and salinity from T, S, and P interface calculate_specific_vol_derivs - module procedure calc_spec_vol_derivs_1d, calculate_spec_vol_derivs_array + module procedure calc_spec_vol_derivs_1d end interface calculate_specific_vol_derivs !> Calculates the second derivatives of density with various combinations of temperature, @@ -125,8 +149,13 @@ module MOM_EOS real :: dTFr_dS !< The derivative of freezing point with salinity [degC ppt-1] real :: dTFr_dp !< The derivative of freezing point with pressure [degC Pa-1] + logical :: use_Wright_2nd_deriv_bug = .false. !< If true, use a separate subroutine that + !! retains a buggy version of the calculations of the second + !! derivative of density with temperature and with temperature and + !! pressure. This bug is corrected in the default version. + ! Unit conversion factors (normally used for dimensional testing but could also allow for -! change of units of arguments to functions +! change of units of arguments to functions) real :: m_to_Z = 1. !< A constant that translates distances in meters to the units of depth [Z m-1 ~> 1] real :: kg_m3_to_R = 1. !< A constant that translates kilograms per meter cubed to the !! units of density [R m3 kg-1 ~> 1] @@ -146,24 +175,36 @@ module MOM_EOS integer, parameter, public :: EOS_LINEAR = 1 !< A named integer specifying an equation of state integer, parameter, public :: EOS_UNESCO = 2 !< A named integer specifying an equation of state integer, parameter, public :: EOS_WRIGHT = 3 !< A named integer specifying an equation of state -integer, parameter, public :: EOS_TEOS10 = 4 !< A named integer specifying an equation of state -integer, parameter, public :: EOS_NEMO = 5 !< A named integer specifying an equation of state - -character*(10), parameter :: EOS_LINEAR_STRING = "LINEAR" !< A string for specifying the equation of state -character*(10), parameter :: EOS_UNESCO_STRING = "UNESCO" !< A string for specifying the equation of state -character*(10), parameter :: EOS_WRIGHT_STRING = "WRIGHT" !< A string for specifying the equation of state -character*(10), parameter :: EOS_TEOS10_STRING = "TEOS10" !< A string for specifying the equation of state -character*(10), parameter :: EOS_NEMO_STRING = "NEMO" !< A string for specifying the equation of state -character*(10), parameter :: EOS_DEFAULT = EOS_WRIGHT_STRING !< The default equation of state +integer, parameter, public :: EOS_WRIGHT_FULL = 4 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_WRIGHT_REDUCED = 5 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_TEOS10 = 6 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_ROQUET_RHO = 7 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_ROQUET_SPV = 8 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_JACKETT06 = 9 !< A named integer specifying an equation of state + +character*(12), parameter :: EOS_LINEAR_STRING = "LINEAR" !< A string for specifying the equation of state +character*(12), parameter :: EOS_UNESCO_STRING = "UNESCO" !< A string for specifying the equation of state +character*(12), parameter :: EOS_JACKETT_STRING = "JACKETT_MCD" !< A string for specifying the equation of state +character*(12), parameter :: EOS_WRIGHT_STRING = "WRIGHT" !< A string for specifying the equation of state +character*(16), parameter :: EOS_WRIGHT_RED_STRING = "WRIGHT_REDUCED" !< A string for specifying the equation of state +character*(12), parameter :: EOS_WRIGHT_FULL_STRING = "WRIGHT_FULL" !< A string for specifying the equation of state +character*(12), parameter :: EOS_TEOS10_STRING = "TEOS10" !< A string for specifying the equation of state +character*(12), parameter :: EOS_NEMO_STRING = "NEMO" !< A string for specifying the equation of state +character*(12), parameter :: EOS_ROQUET_RHO_STRING = "ROQUET_RHO" !< A string for specifying the equation of state +character*(12), parameter :: EOS_ROQUET_SPV_STRING = "ROQUET_SPV" !< A string for specifying the equation of state +character*(12), parameter :: EOS_JACKETT06_STRING = "JACKETT_06" !< A string for specifying the equation of state +character*(12), parameter :: EOS_DEFAULT = EOS_WRIGHT_STRING !< The default equation of state integer, parameter :: TFREEZE_LINEAR = 1 !< A named integer specifying a freezing point expression integer, parameter :: TFREEZE_MILLERO = 2 !< A named integer specifying a freezing point expression integer, parameter :: TFREEZE_TEOS10 = 3 !< A named integer specifying a freezing point expression +integer, parameter :: TFREEZE_TEOSPOLY = 4 !< A named integer specifying a freezing point expression character*(10), parameter :: TFREEZE_LINEAR_STRING = "LINEAR" !< A string for specifying the freezing point expression -character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" !< A string for specifying +character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" !< A string for specifying the + !! freezing point expression +character*(10), parameter :: TFREEZE_TEOSPOLY_STRING = "TEOS_POLY" !< A string for specifying the !! freezing point expression character*(10), parameter :: TFREEZE_TEOS10_STRING = "TEOS10" !< A string for specifying the freezing point expression -character*(10), parameter :: TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING !< The default freezing point expression contains @@ -221,37 +262,17 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in !! combination with scaling stored in EOS [various] ! Local variables - real :: d2RdTT ! Second derivative of density with temperature [kg m-3 degC-2] - real :: d2RdST ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] - real :: d2RdSS ! Second derivative of density with salinity [kg m-3 ppt-2] - real :: d2RdSp ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] - real :: d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - real :: T_scale ! A factor to convert temperature to units of degC [degC C-1 ~> 1] - real :: S_scale ! A factor to convert salinity to units of ppt [ppt S-1 ~> 1] + real :: d2RdTT ! Second derivative of density with temperature [R C-2 ~> kg m-3 degC-2] + real :: d2RdST ! Second derivative of density with temperature and salinity [R S-1 C-1 ~> kg m-3 degC-1 ppt-1] + real :: d2RdSS ! Second derivative of density with salinity [R S-2 ~> kg m-3 ppt-2] + real :: d2RdSp ! Second derivative of density with salinity and pressure [T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1] + real :: d2RdTp ! Second derivative of density with temperature and pressure [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] call calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref) - - p_scale = EOS%RL2_T2_to_Pa - T_scale = EOS%C_to_degC - S_scale = EOS%S_to_ppt - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T_scale*T, S_scale*S, p_scale*pressure, & - d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP) - case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T_scale*T, S_scale*S, p_scale*pressure, & - d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP) - case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T_scale*T, S_scale*S, p_scale*pressure, & - d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP) - case default - call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.") - end select + call calculate_density_second_derivs_scalar(T, S, pressure, d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP, EOS) ! Equation 25 of Stanley et al., 2020. - rho = rho + EOS%kg_m3_to_R * ( 0.5 * (T_scale**2 * d2RdTT) * Tvar + & - ( (S_scale*T_scale * d2RdST) * TScov + 0.5 * (S_scale**2 * d2RdSS) * Svar ) ) + rho = rho + ( 0.5 * d2RdTT * Tvar + ( d2RdST * TScov + 0.5 * d2RdSS * Svar ) ) if (present(scale)) rho = rho * scale @@ -278,13 +299,21 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re call calculate_density_linear(T, S, pressure, rho, start, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts, rho_ref) + call calculate_density_UNESCO(T, S, pressure, rho, start, npts, rho_ref) case (EOS_WRIGHT) call calculate_density_wright(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_WRIGHT_FULL) + call calculate_density_wright_full(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_WRIGHT_REDUCED) + call calculate_density_wright_red(T, S, pressure, rho, start, npts, rho_ref) case (EOS_TEOS10) call calculate_density_teos10(T, S, pressure, rho, start, npts, rho_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_ROQUET_RHO) + call calculate_density_Roquet_rho(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_ROQUET_SPV) + call calculate_density_Roquet_SpV(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_JACKETT06) + call calculate_density_Jackett06(T, S, pressure, rho, start, npts, rho_ref) case default call MOM_error(FATAL, "calculate_density_array: EOS%form_of_EOS is not valid.") end select @@ -295,64 +324,6 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re end subroutine calculate_density_array -!> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs -!! including the variance of T, S and covariance of T-S. -!! The calculation uses only the second order correction in a series as discussed -!! in Stanley et al., 2020. -!! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rho, start, npts, EOS, rho_ref, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] - real, dimension(:), intent(in) :: Tvar !< Variance of potential temperature referenced to the surface [degC2] - real, dimension(:), intent(in) :: TScov !< Covariance of potential temperature and salinity [degC ppt] - real, dimension(:), intent(in) :: Svar !< Variance of salinity [ppt2] - real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [kg m-3] - integer, intent(in) :: start !< Start index for computation - integer, intent(in) :: npts !< Number of point to compute - type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output - !! density, perhaps to other units than kg m-3 [various] - ! Local variables - real, dimension(size(T)) :: & - d2RdTT, & ! Second derivative of density with temperature [kg m-3 degC-2] - d2RdST, & ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] - d2RdSS, & ! Second derivative of density with salinity [kg m-3 ppt-2] - d2RdSp, & ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] - d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] - integer :: j - - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_linear(T, S, pressure, rho, start, npts, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) - call calculate_density_second_derivs_linear(T, S, pressure, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, start, npts) - case (EOS_WRIGHT) - call calculate_density_wright(T, S, pressure, rho, start, npts, rho_ref) - call calculate_density_second_derivs_wright(T, S, pressure, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, start, npts) - case (EOS_TEOS10) - call calculate_density_teos10(T, S, pressure, rho, start, npts, rho_ref) - call calculate_density_second_derivs_teos10(T, S, pressure, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, start, npts) - case default - call MOM_error(FATAL, "calculate_stanley_density_array: EOS%form_of_EOS is not valid.") - end select - - ! Equation 25 of Stanley et al., 2020. - do j=start,start+npts-1 - rho(j) = rho(j) & - + ( 0.5 * d2RdTT(j) * Tvar(j) + ( d2RdST(j) * TScov(j) + 0.5 * d2RdSS(j) * Svar(j) ) ) - enddo - - if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 - rho(j) = scale * rho(j) - enddo ; endif ; endif - -end subroutine calculate_stanley_density_array - !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs, !! potentially limiting the domain of indices that are worked on. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. @@ -425,21 +396,12 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling stored in EOS [various] ! Local variables - real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: T2_scale ! A factor to convert temperature variance to units of degC2 [degC2 C-2 ~> 1] - real :: S2_scale ! A factor to convert salinity variance to units of ppt2 [ppt2 S-2 ~> 1] - real :: TS_scale ! A factor to convert temperature-salinity covariance to units of - ! degC ppt [degC ppt C-1 S-1 ~> 1] - real :: rho_reference ! rho_ref converted to [kg m-3] - real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] - real, dimension(size(rho)) :: Ta ! Temperature converted to [degC] - real, dimension(size(rho)) :: Sa ! Salinity converted to [ppt] real, dimension(size(T)) :: & - d2RdTT, & ! Second derivative of density with temperature [kg m-3 degC-2] - d2RdST, & ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] - d2RdSS, & ! Second derivative of density with salinity [kg m-3 ppt-2] - d2RdSp, & ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] - d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] + d2RdTT, & ! Second derivative of density with temperature [R C-2 ~> kg m-3 degC-2] + d2RdST, & ! Second derivative of density with temperature and salinity [R S-1 C-1 ~> kg m-3 degC-1 ppt-1] + d2RdSS, & ! Second derivative of density with salinity [R S-2 ~> kg m-3 ppt-2] + d2RdSp, & ! Second derivative of density with salinity and pressure [T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1] + d2RdTp ! Second derivative of density with temperature and pressure [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] integer :: i, is, ie, npts if (present(dom)) then @@ -448,50 +410,17 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, is = 1 ; ie = size(rho) ; npts = 1 + ie - is endif - do i=is,ie - pres(i) = EOS%RL2_T2_to_Pa * pressure(i) - Ta(i) = EOS%C_to_degC * T(i) - Sa(i) = EOS%S_to_ppt * S(i) - enddo - T2_scale = EOS%C_to_degC**2 - S2_scale = EOS%S_to_ppt**2 - TS_scale = EOS%C_to_degC*EOS%S_to_ppt - - ! Rho_ref is seems like it is always present when calculate_Stanley_density is called, so - ! always set rho_reference, even though a 0 value can change answers at roundoff with - ! some equations of state. - rho_reference = 0.0 ; if (present(rho_ref)) rho_reference = EOS%R_to_kg_m3*rho_ref - - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_linear(Ta, Sa, pres, rho, is, npts, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_reference) - call calculate_density_second_derivs_linear(Ta, Sa, pres, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, is, npts) - case (EOS_WRIGHT) - call calculate_density_wright(Ta, Sa, pres, rho, is, npts, rho_reference) - call calculate_density_second_derivs_wright(Ta, Sa, pres, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, is, npts) - case (EOS_TEOS10) - call calculate_density_teos10(Ta, Sa, pres, rho, is, npts, rho_reference) - call calculate_density_second_derivs_teos10(Ta, Sa, pres, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, is, npts) - case default - call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.") - end select + call calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref) + call calculate_density_second_derivs_1d(T, S, pressure, d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP, EOS, dom) ! Equation 25 of Stanley et al., 2020. do i=is,ie - rho(i) = rho(i) + ( 0.5 * (T2_scale * d2RdTT(i)) * Tvar(i) + & - ( (TS_scale * d2RdST(i)) * TScov(i) + & - 0.5 * (S2_scale * d2RdSS(i)) * Svar(i) ) ) + rho(i) = rho(i) + ( 0.5 * d2RdTT(i) * Tvar(i) + ( d2RdST(i) * TScov(i) + 0.5 * d2RdSS(i) * Svar(i) ) ) enddo - rho_scale = EOS%kg_m3_to_R - if (present(scale)) rho_scale = rho_scale * scale - if (rho_scale /= 1.0) then ; do i=is,ie - rho(i) = rho_scale * rho(i) - enddo ; endif + if (present(scale)) then ; if (scale /= 1.0) then ; do i=is,ie + rho(i) = scale * rho(i) + enddo ; endif ; endif end subroutine calculate_stanley_density_1d @@ -517,18 +446,26 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) + call calculate_spec_vol_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) case (EOS_WRIGHT) call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) + case (EOS_WRIGHT_FULL) + call calculate_spec_vol_wright_full(T, S, pressure, specvol, start, npts, spv_ref) + case (EOS_WRIGHT_REDUCED) + call calculate_spec_vol_wright_red(T, S, pressure, specvol, start, npts, spv_ref) case (EOS_TEOS10) call calculate_spec_vol_teos10(T, S, pressure, specvol, start, npts, spv_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) + case (EOS_ROQUET_RHO) + call calculate_density_Roquet_rho(T, S, pressure, rho, start, npts) if (present(spv_ref)) then specvol(:) = 1.0 / rho(:) - spv_ref else specvol(:) = 1.0 / rho(:) endif + case (EOS_ROQUET_SpV) + call calculate_spec_vol_Roquet_SpV(T, S, pressure, specvol, start, npts, spv_ref) + case (EOS_JACKETT06) + call calculate_spec_vol_Jackett06(T, S, pressure, specvol, start, npts, spv_ref) case default call MOM_error(FATAL, "calculate_spec_vol_array: EOS%form_of_EOS is not valid.") end select @@ -660,6 +597,8 @@ subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale, scale_fr EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) call calculate_TFreeze_Millero(S_scale*S, p_scale*pressure, T_fr) + case (TFREEZE_TEOSPOLY) + call calculate_TFreeze_TEOS_poly(S_scale*S, p_scale*pressure, T_fr) case (TFREEZE_TEOS10) call calculate_TFreeze_teos10(S_scale*S, p_scale*pressure, T_fr) case default @@ -698,6 +637,8 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) call calculate_TFreeze_Millero(S, pressure, T_fr, start, npts) + case (TFREEZE_TEOSPOLY) + call calculate_TFreeze_TEOS_poly(S, pressure, T_fr, start, npts) case (TFREEZE_TEOS10) call calculate_TFreeze_teos10(S, pressure, T_fr, start, npts) case default @@ -713,6 +654,8 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca call calculate_TFreeze_Millero(S, pres, T_fr, start, npts) case (TFREEZE_TEOS10) call calculate_TFreeze_teos10(S, pres, T_fr, start, npts) + case (TFREEZE_TEOSPOLY) + call calculate_TFreeze_TEOS_poly(S, pres, T_fr, start, npts) case default call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") end select @@ -749,6 +692,8 @@ subroutine calculate_TFreeze_1d(S, pressure, T_fr, EOS, dom) EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) call calculate_TFreeze_Millero(S, pressure, T_fr, is, npts) + case (TFREEZE_TEOSPOLY) + call calculate_TFreeze_TEOS_poly(S, pressure, T_fr, is, npts) case (TFREEZE_TEOS10) call calculate_TFreeze_teos10(S, pressure, T_fr, is, npts) case default @@ -765,6 +710,8 @@ subroutine calculate_TFreeze_1d(S, pressure, T_fr, EOS, dom) EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) call calculate_TFreeze_Millero(Sa, pres, T_fr, is, npts) + case (TFREEZE_TEOSPOLY) + call calculate_TFreeze_TEOS_poly(Sa, pres, T_fr, is, npts) case (TFREEZE_TEOS10) call calculate_TFreeze_teos10(Sa, pres, T_fr, is, npts) case default @@ -804,13 +751,21 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & EOS%dRho_dT, EOS%dRho_dS, start, npts) case (EOS_UNESCO) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + call calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, start, npts) case (EOS_WRIGHT) call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT_FULL) + call calculate_density_derivs_wright_full(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT_REDUCED) + call calculate_density_derivs_wright_red(T, S, pressure, drho_dT, drho_dS, start, npts) case (EOS_TEOS10) call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_NEMO) - call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_ROQUET_RHO) + call calculate_density_derivs_Roquet_rho(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_ROQUET_SPV) + call calculate_density_derivs_Roquet_SpV(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_JACKETT06) + call calculate_density_derivs_Jackett06(T, S, pressure, drho_dT, drho_dS, start, npts) case default call MOM_error(FATAL, "calculate_density_derivs_array: EOS%form_of_EOS is not valid.") end select @@ -894,24 +849,34 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: dRdT_scale ! A factor to convert drho_dT to the desired units [R degC m3 C-1 kg-1 ~> 1] real :: dRdS_scale ! A factor to convert drho_dS to the desired units [R ppt m3 S-1 kg-1 ~> 1] - real :: pres ! Pressure converted to [Pa] - real :: Ta ! Temperature converted to [degC] - real :: Sa ! Salinity converted to [ppt] + real :: pres(1) ! Pressure converted to [Pa] + real :: Ta(1) ! Temperature converted to [degC] + real :: Sa(1) ! Salinity converted to [ppt] + real :: dR_dT(1) ! A copy of drho_dT in mks units [kg m-3 degC-1] + real :: dR_dS(1) ! A copy of drho_dS in mks units [kg m-3 ppt-1] - pres = EOS%RL2_T2_to_Pa*pressure - Ta = EOS%C_to_degC * T - Sa = EOS%S_to_ppt * S + pres(1) = EOS%RL2_T2_to_Pa*pressure + Ta(1) = EOS%C_to_degC * T + Sa(1) = EOS%S_to_ppt * S select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_derivs_linear(Ta, Sa, pres, drho_dT, drho_dS, & + call calculate_density_derivs_linear(Ta(1), Sa(1), pres(1),drho_dT, drho_dS, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_WRIGHT) - call calculate_density_derivs_wright(Ta, Sa, pres, drho_dT, drho_dS) + call calculate_density_derivs_wright(Ta(1), Sa(1), pres(1),drho_dT, drho_dS) + case (EOS_WRIGHT_FULL) + call calculate_density_derivs_wright_full(Ta(1), Sa(1), pres(1),drho_dT, drho_dS) + case (EOS_WRIGHT_REDUCED) + call calculate_density_derivs_wright_red(Ta(1), Sa(1), pres(1),drho_dT, drho_dS) case (EOS_TEOS10) - call calculate_density_derivs_teos10(Ta, Sa, pres, drho_dT, drho_dS) + call calculate_density_derivs_teos10(Ta(1), Sa(1), pres(1), drho_dT, drho_dS) + case (EOS_JACKETT06) + call calculate_density_derivs_Jackett06(Ta(1), Sa(1), pres(1),drho_dT, drho_dS) case default - call MOM_error(FATAL, "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") + ! Some equations of state do not have a scalar form of calculate_density_derivs, so try the array form. + call calculate_density_derivs_array(Ta, Sa, pres, dR_dT, dR_dS, 1, 1, EOS) + drho_dT = dR_dT(1); drho_dS = dR_dS(1) end select rho_scale = EOS%kg_m3_to_R @@ -965,13 +930,36 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + if (EOS%use_Wright_2nd_deriv_bug) then + call calc_density_second_derivs_wright_buggy(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + else + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + endif + case (EOS_WRIGHT_FULL) + call calculate_density_second_derivs_wright_full(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_WRIGHT_REDUCED) + call calculate_density_second_derivs_wright_red(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_UNESCO) + call calculate_density_second_derivs_UNESCO(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_ROQUET_RHO) + call calculate_density_second_derivs_Roquet_rho(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_ROQUET_SPV) + call calculate_density_second_derivs_Roquet_SpV(T, S, pressure, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_TEOS10) call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_JACKETT06) + call calculate_density_second_derivs_Jackett06(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case default - call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_density_second_derivs: EOS%form_of_EOS is not valid.") end select else do i=is,ie @@ -984,13 +972,36 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d call calculate_density_second_derivs_linear(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + if (EOS%use_Wright_2nd_deriv_bug) then + call calc_density_second_derivs_wright_buggy(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + else + call calculate_density_second_derivs_wright(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + endif + case (EOS_WRIGHT_FULL) + call calculate_density_second_derivs_wright_full(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_WRIGHT_REDUCED) + call calculate_density_second_derivs_wright_red(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_UNESCO) + call calculate_density_second_derivs_UNESCO(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_ROQUET_RHO) + call calculate_density_second_derivs_Roquet_rho(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_ROQUET_SpV) + call calculate_density_second_derivs_Roquet_SpV(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_TEOS10) call calculate_density_second_derivs_teos10(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) + case (EOS_JACKETT06) + call calculate_density_second_derivs_Jackett06(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case default - call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_density_second_derivs: EOS%form_of_EOS is not valid.") end select endif @@ -1057,13 +1068,36 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr call calculate_density_second_derivs_linear(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + if (EOS%use_Wright_2nd_deriv_bug) then + call calc_density_second_derivs_wright_buggy(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + else + call calculate_density_second_derivs_wright(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + endif + case (EOS_WRIGHT_FULL) + call calculate_density_second_derivs_wright_full(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + case (EOS_WRIGHT_REDUCED) + call calculate_density_second_derivs_wright_red(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + case (EOS_UNESCO) + call calculate_density_second_derivs_UNESCO(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + case (EOS_ROQUET_RHO) + call calculate_density_second_derivs_Roquet_rho(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + case (EOS_ROQUET_SPV) + call calculate_density_second_derivs_Roquet_SpV(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_TEOS10) call calculate_density_second_derivs_teos10(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) + case (EOS_JACKETT06) + call calculate_density_second_derivs_Jackett06(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case default - call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_density_second_derivs: EOS%form_of_EOS is not valid.") end select rho_scale = EOS%kg_m3_to_R @@ -1119,23 +1153,26 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) - enddo + call calculate_specvol_derivs_UNESCO(T, S, pressure, dSV_dT, dSV_dS, start, npts) case (EOS_WRIGHT) call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_WRIGHT_FULL) + call calculate_specvol_derivs_wright_full(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_WRIGHT_REDUCED) + call calculate_specvol_derivs_wright_red(T, S, pressure, dSV_dT, dSV_dS, start, npts) case (EOS_TEOS10) call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_ROQUET_RHO) + call calculate_density_Roquet_rho(T, S, pressure, rho, start, npts) + call calculate_density_derivs_Roquet_rho(T, S, pressure, drho_dT, drho_dS, start, npts) do j=start,start+npts-1 dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) enddo + case (EOS_ROQUET_SPV) + call calculate_specvol_derivs_Roquet_SpV(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_JACKETT06) + call calculate_specvol_derivs_Jackett06(T, S, pressure, dSV_dT, dSV_dS, start, npts) case default call MOM_error(FATAL, "calculate_spec_vol_derivs_array: EOS%form_of_EOS is not valid.") end select @@ -1233,13 +1270,21 @@ subroutine calculate_compress_1d(T, S, pressure, rho, drho_dp, EOS, dom) call calculate_compress_linear(Ta, Sa, pres, rho, drho_dp, is, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_UNESCO) - call calculate_compress_unesco(Ta, Sa, pres, rho, drho_dp, is, npts) + call calculate_compress_UNESCO(Ta, Sa, pres, rho, drho_dp, is, npts) case (EOS_WRIGHT) call calculate_compress_wright(Ta, Sa, pres, rho, drho_dp, is, npts) + case (EOS_WRIGHT_FULL) + call calculate_compress_wright_full(Ta, Sa, pres, rho, drho_dp, is, npts) + case (EOS_WRIGHT_REDUCED) + call calculate_compress_wright_red(Ta, Sa, pres, rho, drho_dp, is, npts) case (EOS_TEOS10) call calculate_compress_teos10(Ta, Sa, pres, rho, drho_dp, is, npts) - case (EOS_NEMO) - call calculate_compress_nemo(Ta, Sa, pres, rho, drho_dp, is, npts) + case (EOS_ROQUET_RHO) + call calculate_compress_Roquet_rho(Ta, Sa, pres, rho, drho_dp, is, npts) + case (EOS_ROQUET_SpV) + call calculate_compress_Roquet_SpV(Ta, Sa, pres, rho, drho_dp, is, npts) + case (EOS_JACKETT06) + call calculate_compress_Jackett06(Ta, Sa, pres, rho, drho_dp, is, npts) case default call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") end select @@ -1281,6 +1326,134 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) end subroutine calculate_compress_scalar +!> Calls the appropriate subroutine to calculate the layer averaged specific volume either using +!! Boole's rule quadrature or analytical and nearly-analytical averages in pressure. +subroutine average_specific_vol(T, S, p_t, dp, SpV_avg, EOS, dom, scale) + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] + real, dimension(:), intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] + real, dimension(:), intent(in) :: dp !< Pressure change in the layer [R L2 T-2 ~> Pa] + real, dimension(:), intent(inout) :: SpV_avg !< The vertical average specific volume + !! in the layer [R-1 ~> m3 kg-1] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale + !! output specific volume in combination with + !! scaling stored in EOS [various] + + ! Local variables + real, dimension(size(T)) :: pres ! Layer-top pressure converted to [Pa] + real, dimension(size(T)) :: dpres ! Pressure change converted to [Pa] + real, dimension(size(T)) :: Ta ! Temperature converted to [degC] + real, dimension(size(T)) :: Sa ! Salinity converted to [ppt] + real :: T5(5) ! Temperatures at five quadrature points [C ~> degC] + real :: S5(5) ! Salinities at five quadrature points [S ~> ppt] + real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] + real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] + real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] + integer :: i, n, is, ie, npts + + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + else + is = 1 ; ie = size(T) ; npts = 1 + ie - is + endif + + if (EOS%EOS_quadrature) then + do i=is,ie + do n=1,5 + T5(n) = T(i) ; S5(n) = S(i) + p5(n) = p_t(i) + 0.25*real(5-n)*dp(i) + enddo + call calculate_spec_vol(T5, S5, p5, a5, EOS) + + ! Use Boole's rule to estimate the average specific volume. + SpV_avg(i) = C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + 12.0*a5(3)) + enddo + elseif ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call avg_spec_vol_linear(T, S, p_t, dp, SpV_avg, is, npts, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS) + case (EOS_WRIGHT) + call avg_spec_vol_wright(T, S, p_t, dp, SpV_avg, is, npts) + case (EOS_WRIGHT_FULL) + call avg_spec_vol_wright_full(T, S, p_t, dp, SpV_avg, is, npts) + case (EOS_WRIGHT_REDUCED) + call avg_spec_vol_wright_red(T, S, p_t, dp, SpV_avg, is, npts) + case default + call MOM_error(FATAL, "No analytic average specific volume option is available with this EOS!") + end select + else + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * p_t(i) + dpres(i) = EOS%RL2_T2_to_Pa * dp(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call avg_spec_vol_linear(Ta, Sa, pres, dpres, SpV_avg, is, npts, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS) + case (EOS_WRIGHT) + call avg_spec_vol_wright(Ta, Sa, pres, dpres, SpV_avg, is, npts) + case (EOS_WRIGHT_FULL) + call avg_spec_vol_wright_full(Ta, Sa, pres, dpres, SpV_avg, is, npts) + case (EOS_WRIGHT_REDUCED) + call avg_spec_vol_wright_red(Ta, Sa, pres, dpres, SpV_avg, is, npts) + case default + call MOM_error(FATAL, "No analytic average specific volume option is available with this EOS!") + end select + endif + + spv_scale = EOS%R_to_kg_m3 + if (EOS%EOS_quadrature) spv_scale = 1.0 + if (present(scale)) spv_scale = spv_scale * scale + if (spv_scale /= 1.0) then ; do i=is,ie + SpV_avg(i) = spv_scale * SpV_avg(i) + enddo ; endif + +end subroutine average_specific_vol + +!> Return the range of temperatures, salinities and pressures for which the equation of state that +!! is being used has been fitted to observations. Care should be taken when applying +!! this equation of state outside of its fit range. +subroutine EoS_fit_range(EOS, T_min, T_max, S_min, S_max, p_min, p_max) + type(EOS_type), intent(in) :: EOS !< Equation of state structure + real, optional, intent(out) :: T_min !< The minimum temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum salinity over which this EoS is fitted [ppt] + real, optional, intent(out) :: S_max !< The maximum salinity over which this EoS is fitted [ppt] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call EoS_fit_range_linear(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_UNESCO) + call EoS_fit_range_UNESCO(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_WRIGHT) + call EoS_fit_range_Wright(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_WRIGHT_FULL) + call EoS_fit_range_Wright_full(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_WRIGHT_REDUCED) + call EoS_fit_range_Wright_red(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_TEOS10) + call EoS_fit_range_TEOS10(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_ROQUET_RHO) + call EoS_fit_range_Roquet_rho(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_ROQUET_SpV) + call EoS_fit_range_Roquet_SpV(T_min, T_max, S_min, S_max, p_min, p_max) + case (EOS_JACKETT06) + call EoS_fit_range_Jackett06(T_min, T_max, S_min, S_max, p_min, p_max) + case default + call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") + end select + +end subroutine EoS_fit_range + !> This subroutine returns a two point integer array indicating the domain of i-indices !! to work on in EOS calls based on information from a hor_index type @@ -1351,7 +1524,6 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real :: dRdS_scale ! A factor to convert drho_dS to the desired units [R ppt m3 S-1 kg-1 ~> 1] - ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical ! integration be used instead of analytic. This is a safety check. if (EOS%EOS_quadrature) call MOM_error(FATAL, "EOS_quadrature is set!") @@ -1369,6 +1541,16 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & inty_dza, halo_size, bathyP, dP_tiny, useMassWghtInterp, & SV_scale=EOS%R_to_kg_m3, pres_scale=EOS%RL2_T2_to_Pa, & temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt) + case (EOS_WRIGHT_FULL) + call int_spec_vol_dp_wright_full(T, S, p_t, p_b, alpha_ref, HI, dza, intp_dza, intx_dza, & + inty_dza, halo_size, bathyP, dP_tiny, useMassWghtInterp, & + SV_scale=EOS%R_to_kg_m3, pres_scale=EOS%RL2_T2_to_Pa, & + temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt) + case (EOS_WRIGHT_REDUCED) + call int_spec_vol_dp_wright_red(T, S, p_t, p_b, alpha_ref, HI, dza, intp_dza, intx_dza, & + inty_dza, halo_size, bathyP, dP_tiny, useMassWghtInterp, & + SV_scale=EOS%R_to_kg_m3, pres_scale=EOS%RL2_T2_to_Pa, & + temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt) case default call MOM_error(FATAL, "No analytic integration option is available with this EOS!") end select @@ -1458,6 +1640,32 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & dz_neglect, useMassWghtInterp, Z_0p=Z_0p) endif + case (EOS_WRIGHT_FULL) + rho_scale = EOS%kg_m3_to_R + pres_scale = EOS%RL2_T2_to_Pa + if ((rho_scale /= 1.0) .or. (pres_scale /= 1.0) .or. (EOS%C_to_degC /= 1.0) .or. (EOS%S_to_ppt /= 1.0)) then + call int_density_dz_wright_full(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp, rho_scale, pres_scale, & + temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt, Z_0p=Z_0p) + else + call int_density_dz_wright_full(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp, Z_0p=Z_0p) + endif + case (EOS_WRIGHT_REDUCED) + rho_scale = EOS%kg_m3_to_R + pres_scale = EOS%RL2_T2_to_Pa + if ((rho_scale /= 1.0) .or. (pres_scale /= 1.0) .or. (EOS%C_to_degC /= 1.0) .or. (EOS%S_to_ppt /= 1.0)) then + call int_density_dz_wright_red(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp, rho_scale, pres_scale, & + temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt, Z_0p=Z_0p) + else + call int_density_dz_wright_red(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp, Z_0p=Z_0p) + endif case default call MOM_error(FATAL, "No analytic integration option is available with this EOS!") end select @@ -1481,30 +1689,44 @@ subroutine EOS_init(param_file, EOS, US) ! Local variables # include "version_variable.h" character(len=40) :: mdl = "MOM_EOS" ! This module's name. + character(len=12) :: TFREEZE_DEFAULT ! The default freezing point expression character(len=40) :: tmpstr + logical :: EOS_quad_default ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "EQN_OF_STATE", tmpstr, & - "EQN_OF_STATE determines which ocean equation of state "//& - "should be used. Currently, the valid choices are "//& - '"LINEAR", "UNESCO", "WRIGHT", "NEMO" and "TEOS10". '//& - "This is only used if USE_EOS is true.", default=EOS_DEFAULT) + "EQN_OF_STATE determines which ocean equation of state should be used. "//& + 'Currently, the valid choices are "LINEAR", "UNESCO", "JACKETT_MCD", '//& + '"WRIGHT", "WRIGHT_REDUCED", "WRIGHT_FULL", "NEMO", "ROQUET_RHO", "ROQUET_SPV" '//& + 'and "TEOS10". This is only used if USE_EOS is true.', default=EOS_DEFAULT) select case (uppercase(tmpstr)) case (EOS_LINEAR_STRING) EOS%form_of_EOS = EOS_LINEAR case (EOS_UNESCO_STRING) EOS%form_of_EOS = EOS_UNESCO + case (EOS_JACKETT_STRING) + EOS%form_of_EOS = EOS_UNESCO case (EOS_WRIGHT_STRING) EOS%form_of_EOS = EOS_WRIGHT + case (EOS_WRIGHT_RED_STRING) + EOS%form_of_EOS = EOS_WRIGHT_REDUCED + case (EOS_WRIGHT_FULL_STRING) + EOS%form_of_EOS = EOS_WRIGHT_FULL case (EOS_TEOS10_STRING) EOS%form_of_EOS = EOS_TEOS10 case (EOS_NEMO_STRING) - EOS%form_of_EOS = EOS_NEMO + EOS%form_of_EOS = EOS_ROQUET_RHO + case (EOS_ROQUET_RHO_STRING) + EOS%form_of_EOS = EOS_ROQUET_RHO + case (EOS_ROQUET_SPV_STRING) + EOS%form_of_EOS = EOS_ROQUET_SPV + case (EOS_JACKETT06_STRING) + EOS%form_of_EOS = EOS_JACKETT06 case default call MOM_error(FATAL, "interpret_eos_selection: EQN_OF_STATE "//& - trim(tmpstr) // "in input file is invalid.") + trim(tmpstr) // " in input file is invalid.") end select call MOM_mesg('interpret_eos_selection: equation of state set to "' // & trim(tmpstr)//'"', 5) @@ -1513,8 +1735,7 @@ subroutine EOS_init(param_file, EOS, US) EOS%Compressible = .false. call get_param(param_file, mdl, "RHO_T0_S0", EOS%Rho_T0_S0, & "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", "//& - "this is the density at T=0, S=0.", units="kg m-3", & - default=1000.0) + "this is the density at T=0, S=0.", units="kg m-3", default=1000.0) call get_param(param_file, mdl, "DRHO_DT", EOS%dRho_dT, & "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", "//& "this is the partial derivative of density with "//& @@ -1524,21 +1745,37 @@ subroutine EOS_init(param_file, EOS, US) "this is the partial derivative of density with "//& "salinity.", units="kg m-3 PSU-1", default=0.8) endif + if (EOS%form_of_EOS == EOS_WRIGHT) then + call get_param(param_file, mdl, "USE_WRIGHT_2ND_DERIV_BUG", EOS%use_Wright_2nd_deriv_bug, & + "If true, use a bug in the calculation of the second derivatives of density "//& + "with temperature and with temperature and pressure that causes some terms "//& + "to be only 2/3 of what they should be.", default=.false.) + endif + EOS_quad_default = .not.((EOS%form_of_EOS == EOS_LINEAR) .or. & + (EOS%form_of_EOS == EOS_WRIGHT) .or. & + (EOS%form_of_EOS == EOS_WRIGHT_REDUCED) .or. & + (EOS%form_of_EOS == EOS_WRIGHT_FULL)) call get_param(param_file, mdl, "EOS_QUADRATURE", EOS%EOS_quadrature, & "If true, always use the generic (quadrature) code "//& - "code for the integrals of density.", default=.false.) + "code for the integrals of density.", default=EOS_quad_default) + TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING + if ((EOS%form_of_EOS == EOS_TEOS10 .or. EOS%form_of_EOS == EOS_ROQUET_RHO .or. & + EOS%form_of_EOS == EOS_ROQUET_SPV)) & + TFREEZE_DEFAULT = TFREEZE_TEOS10_STRING call get_param(param_file, mdl, "TFREEZE_FORM", tmpstr, & "TFREEZE_FORM determines which expression should be "//& "used for the freezing point. Currently, the valid "//& - 'choices are "LINEAR", "MILLERO_78", "TEOS10"', & + 'choices are "LINEAR", "MILLERO_78", "TEOS_POLY", "TEOS10"', & default=TFREEZE_DEFAULT) select case (uppercase(tmpstr)) case (TFREEZE_LINEAR_STRING) EOS%form_of_TFreeze = TFREEZE_LINEAR case (TFREEZE_MILLERO_STRING) EOS%form_of_TFreeze = TFREEZE_MILLERO + case (TFREEZE_TEOSPOLY_STRING) + EOS%form_of_TFreeze = TFREEZE_TEOSPOLY case (TFREEZE_TEOS10_STRING) EOS%form_of_TFreeze = TFREEZE_TEOS10 case default @@ -1563,10 +1800,11 @@ subroutine EOS_init(param_file, EOS, US) units="deg C Pa-1", default=0.0) endif - if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. & - EOS%form_of_TFreeze /= TFREEZE_TEOS10) then - call MOM_error(FATAL, "interpret_eos_selection: EOS_TEOS10 or EOS_NEMO \n" //& - "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 .") + if ((EOS%form_of_EOS == EOS_TEOS10 .or. EOS%form_of_EOS == EOS_ROQUET_RHO .or. & + EOS%form_of_EOS == EOS_ROQUET_SPV) .and. & + .not.((EOS%form_of_TFreeze == TFREEZE_TEOS10) .or. (EOS%form_of_TFreeze == TFREEZE_TEOSPOLY)) ) then + call MOM_error(FATAL, "interpret_eos_selection: EOS_TEOS10 or EOS_ROQUET_RHO or EOS_ROQUET_SPV "//& + "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 or TFREEZE_TEOSPOLY.") endif ! Unit conversions @@ -1652,27 +1890,24 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) intent(in) :: mask_z !< 3d mask regulating which points to convert [nondim] type(EOS_type), intent(in) :: EOS !< Equation of state structure - real :: gsw_sr_from_sp ! Reference salinity after conversion from practical salinity [ppt] - real :: gsw_ct_from_pt ! Conservative temperature after conversion from potential temperature [degC] + real, parameter :: Sref_Sprac = (35.16504/35.0) ! The TEOS 10 conversion factor to go from + ! practical salinity to reference salinity [nondim] integer :: i, j, k - if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return + if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_ROQUET_RHO) .and. & + (EOS%form_of_EOS /= EOS_ROQUET_SPV)) return do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec if (mask_z(i,j,k) >= 1.0) then - S(i,j,k) = EOS%ppt_to_S*gsw_sr_from_sp(EOS%S_to_ppt*S(i,j,k)) -! Get absolute salinity from practical salinity, converting pressures from Pascal to dbar. -! If this option is activated, pressure will need to be added as an argument, and it should be -! moved out into module that is not shared between components, where the ocean_grid can be used. -! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),pres(i,j,k)*1.0e-4,G%geoLonT(i,j),G%geoLatT(i,j)) - T(i,j,k) = EOS%degC_to_C*gsw_ct_from_pt(EOS%S_to_ppt*S(i,j,k), EOS%S_to_ppt*T(i,j,k)) + S(i,j,k) = Sref_Sprac * S(i,j,k) + T(i,j,k) = EOS%degC_to_C*poTemp_to_consTemp(EOS%S_to_ppt*S(i,j,k), EOS%S_to_ppt*T(i,j,k)) endif enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 !> Converts an array of conservative temperatures to potential temperatures. The input arguments -!! use the dimesionally rescaling as specified within the EOS type. The output potential +!! use the dimensionally rescaling as specified within the EOS type. The output potential !! temperature uses this same scaling, but this can be replaced by the factor given by scale. subroutine cons_temp_to_pot_temp(T, S, poTemp, EOS, dom, scale) real, dimension(:), intent(in) :: T !< Conservative temperature [C ~> degC] @@ -1700,13 +1935,13 @@ subroutine cons_temp_to_pot_temp(T, S, poTemp, EOS, dom, scale) endif if ((EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then - poTemp(is:ie) = gsw_pt_from_ct(S(is:ie), T(is:ie)) + poTemp(is:ie) = consTemp_to_poTemp(T(is:ie), S(is:ie)) else do i=is,ie Ta(i) = EOS%C_to_degC * T(i) Sa(i) = EOS%S_to_ppt * S(i) enddo - poTemp(is:ie) = gsw_pt_from_ct(Sa(is:ie), Ta(is:ie)) + poTemp(is:ie) = consTemp_to_poTemp(Ta(is:ie), Sa(is:ie)) endif T_scale = EOS%degC_to_C @@ -1718,8 +1953,55 @@ subroutine cons_temp_to_pot_temp(T, S, poTemp, EOS, dom, scale) end subroutine cons_temp_to_pot_temp +!> Converts an array of potential temperatures to conservative temperatures. The input arguments +!! use the dimensionally rescaling as specified within the EOS type. The output potential +!! temperature uses this same scaling, but this can be replaced by the factor given by scale. +subroutine pot_temp_to_cons_temp(T, S, consTemp, EOS, dom, scale) + real, dimension(:), intent(in) :: T !< Potential temperature [C ~> degC] + real, dimension(:), intent(in) :: S !< Absolute salinity [S ~> ppt] + real, dimension(:), intent(inout) :: consTemp !< The conservative temperature [C ~> degC] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output + !! potential temperature in place of with scaling stored + !! in EOS. A value of 1.0 returns temperatures in [degC], + !! while the default is equivalent to EOS%degC_to_C. + + ! Local variables + real, dimension(size(T)) :: Tp ! Potential temperature converted to [degC] + real, dimension(size(S)) :: Sa ! Absolute salinity converted to [ppt] + real :: T_scale ! A factor to convert potential temperature from degC to the desired units [C degC-1 ~> 1] + integer :: i, is, ie + + if (present(dom)) then + is = dom(1) ; ie = dom(2) + else + is = 1 ; ie = size(T) + endif + + + if ((EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then + consTemp(is:ie) = poTemp_to_consTemp(T(is:ie), S(is:ie)) + else + do i=is,ie + Tp(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + consTemp(is:ie) = poTemp_to_consTemp(Tp(is:ie), Sa(is:ie)) + endif + + T_scale = EOS%degC_to_C + if (present(scale)) T_scale = scale + if (T_scale /= 1.0) then ; do i=is,ie + consTemp(i) = T_scale * consTemp(i) + enddo ; endif + +end subroutine pot_temp_to_cons_temp + + !> Converts an array of absolute salinity to practical salinity. The input arguments -!! use the dimesionally rescaling as specified within the EOS type. The output potential +!! use the dimensionally rescaling as specified within the EOS type. The output potential !! temperature uses this same scaling, but this can be replaced by the factor given by scale. subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) real, dimension(:), intent(in) :: S !< Absolute salinity [S ~> ppt] @@ -1735,6 +2017,8 @@ subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) ! Local variables real, dimension(size(S)) :: Sa ! Salinity converted to [ppt] real :: S_scale ! A factor to convert practical salinity from ppt to the desired units [S ppt-1 ~> 1] + real, parameter :: Sprac_Sref = (35.0/35.16504) ! The TEOS 10 conversion factor to go from + ! reference salinity to practical salinity [nondim] integer :: i, is, ie if (present(dom)) then @@ -1743,22 +2027,61 @@ subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) is = 1 ; ie = size(S) endif - if ((EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then - prSaln(is:ie) = gsw_sp_from_sr(Sa(is:ie)) + if (present(scale)) then + S_scale = Sprac_Sref * scale + do i=is,ie + prSaln(i) = S_scale * S(i) + enddo else - do i=is,ie ; Sa(i) = EOS%S_to_ppt * S(i) ; enddo - prSaln(is:ie) = gsw_sp_from_sr(Sa(is:ie)) + do i=is,ie + prSaln(i) = Sprac_Sref * S(i) + enddo endif - S_scale = EOS%ppt_to_S - if (present(scale)) S_scale = scale - if (S_scale /= 1.0) then ; do i=is,ie - prSaln(i) = S_scale * prSaln(i) - enddo ; endif - end subroutine abs_saln_to_prac_saln +!> Converts an array of absolute salinity to practical salinity. The input arguments +!! use the dimensionally rescaling as specified within the EOS type. The output potential +!! temperature uses this same scaling, but this can be replaced by the factor given by scale. +subroutine prac_saln_to_abs_saln(S, absSaln, EOS, dom, scale) + real, dimension(:), intent(in) :: S !< Practical salinity [S ~> ppt] + real, dimension(:), intent(inout) :: absSaln !< Absolute salinity [S ~> ppt] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output + !! practical in place of with scaling stored + !! in EOS. A value of 1.0 returns salinities in [PSU], + !! while the default is equivalent to EOS%ppt_to_S. + + ! Local variables + real, dimension(size(S)) :: Sp ! Salinity converted to [ppt] + real :: S_scale ! A factor to convert practical salinity from ppt to the desired units [S ppt-1 ~> 1] + real, parameter :: Sref_Sprac = (35.16504/35.0) ! The TEOS 10 conversion factor to go from + ! practical salinity to reference salinity [nondim] + integer :: i, is, ie + + if (present(dom)) then + is = dom(1) ; ie = dom(2) + else + is = 1 ; ie = size(S) + endif + + if (present(scale)) then + S_scale = Sref_Sprac * scale + do i=is,ie + absSaln(i) = S_scale * S(i) + enddo + else + do i=is,ie + absSaln(i) = Sref_Sprac * S(i) + enddo + endif + +end subroutine prac_saln_to_abs_saln + + !> Return value of EOS_quadrature logical function EOS_quadrature(EOS) type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -1770,12 +2093,12 @@ end function EOS_quadrature !> Extractor routine for the EOS type if the members need to be accessed outside this module subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) - type(EOS_type), intent(in) :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, optional, intent(out) :: form_of_EOS !< A coded integer indicating the equation of state to use. integer, optional, intent(out) :: form_of_TFreeze !< A coded integer indicating the expression for - !! the potential temperature of the freezing point. + !! the potential temperature of the freezing point. logical, optional, intent(out) :: EOS_quadrature !< If true, always use the generic (quadrature) - !! code for the integrals of density. + !! code for the integrals of density. logical, optional, intent(out) :: Compressible !< If true, in situ density is a function of pressure. real , optional, intent(out) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt [kg m-3] real , optional, intent(out) :: drho_dT !< Partial derivative of density with temperature @@ -1801,10 +2124,631 @@ subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, end subroutine extract_member_EOS +!> Runs unit tests for consistency on the equations of state. +!! This should only be called from a single/root thread. +!! It returns True if any test fails, otherwise it returns False. +logical function EOS_unit_tests(verbose) + logical, intent(in) :: verbose !< If true, write results to stdout + ! Local variables + type(EOS_type) :: EOS_tmp + logical :: fail + + if (verbose) write(stdout,*) '==== MOM_EOS: EOS_unit_tests ====' + EOS_unit_tests = .false. ! Normally return false + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_TEOS10) + fail = test_TS_conversion_consistency(T_cons=9.989811727177308, S_abs=35.16504, & + T_pot=10.0, S_prac=35.0, EOS=EOS_tmp, verbose=verbose) + if (verbose .and. fail) call MOM_error(WARNING, "Some EOS variable conversions tests have failed.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_UNESCO) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "UNESCO", & + rho_check=1027.54345796120*EOS_tmp%kg_m3_to_R) + if (verbose .and. fail) call MOM_error(WARNING, "UNESCO EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_WRIGHT_FULL) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "WRIGHT_FULL", & + rho_check=1027.55177447616*EOS_tmp%kg_m3_to_R, avg_Sv_check=.true.) + if (verbose .and. fail) call MOM_error(WARNING, "WRIGHT_FULL EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_WRIGHT_REDUCED) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "WRIGHT_REDUCED", & + rho_check=1027.54303596346*EOS_tmp%kg_m3_to_R, avg_Sv_check=.true.) + if (verbose .and. fail) call MOM_error(WARNING, "WRIGHT_REDUCED EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + ! This test is deliberately outside of the fit range for WRIGHT_REDUCED, and it results in the expected warnings. + ! call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_WRIGHT_REDUCED) + ! fail = test_EOS_consistency(25.0, 15.0, 1.0e7, EOS_tmp, verbose, "WRIGHT_REDUCED", & + ! rho_check=1012.625699301455*EOS_tmp%kg_m3_to_R) + ! if (verbose .and. fail) call MOM_error(WARNING, "WRIGHT_REDUCED EOS has failed some self-consistency tests.") + ! EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_WRIGHT) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "WRIGHT", & + rho_check=1027.54303596346*EOS_tmp%kg_m3_to_R, avg_Sv_check=.true.) + if (verbose .and. fail) call MOM_error(WARNING, "WRIGHT EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_ROQUET_RHO) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "ROQUET_RHO", & + rho_check=1027.42385663668*EOS_tmp%kg_m3_to_R) + if (verbose .and. fail) call MOM_error(WARNING, "ROQUET_RHO EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_ROQUET_SPV) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "ROQUET_SPV", & + rho_check=1027.42387475199*EOS_tmp%kg_m3_to_R) + if (verbose .and. fail) call MOM_error(WARNING, "ROQUET_SPV EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_JACKETT06) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "JACKETT06", & + rho_check=1027.539690758425*EOS_tmp%kg_m3_to_R) + if (verbose .and. fail) call MOM_error(WARNING, "JACKETT06 EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + ! The TEOS10 equation of state is not passing the self consistency tests for dho_dS_dp due + ! to a bug (a missing division by the square root of offset-salinity) on line 111 of + ! pkg/GSW-Fortan/toolbox/gsw_specvol_second_derivatives.f90. This bug has been highlighted in an + ! issue posted to the TEOS-10/GSW-Fortran page at github.com/TEOS-10/GSW-Fortran/issues/26, and + ! it will be corrected by github.com/mom-ocean/GSW-Fortran/pull/1 . + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_TEOS10) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "TEOS10", skip_2nd=.true., & + rho_check=1027.42355961492*EOS_tmp%kg_m3_to_R) + if (verbose .and. fail) call MOM_error(WARNING, "TEOS10 EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_ROQUET_RHO) + fail = test_EOS_consistency(10.0, 30.0, 1.0e7, EOS_tmp, verbose, "ROQUET_RHO", & + rho_check=1027.45140117152*EOS_tmp%kg_m3_to_R) + ! The corresponding check value published by Roquet et al. (2015) is 1027.45140 [kg m-3]. + if (verbose .and. fail) call MOM_error(WARNING, "Roquet_rho EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_ROQUET_SPV) + fail = test_EOS_consistency(10.0, 30.0, 1.0e7, EOS_tmp, verbose, "ROQUET_SPV", & + spv_check=9.73282046614623e-04*EOS_tmp%R_to_kg_m3) + ! The corresponding check value here published by Roquet et al. (2015) is 9.732819628e-04 [m3 kg-1], + ! but the order of arithmetic there was not completely specified with parentheses. + if (verbose .and. fail) call MOM_error(WARNING, "ROQUET_SPV EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_EOS=EOS_LINEAR, Rho_T0_S0=1000.0, drho_dT=-0.2, dRho_dS=0.8) + fail = test_EOS_consistency(25.0, 35.0, 1.0e7, EOS_tmp, verbose, "LINEAR", & + rho_check=1023.0*EOS_tmp%kg_m3_to_R, avg_Sv_check=.true.) + if (verbose .and. fail) call MOM_error(WARNING, "LINEAR EOS has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + ! Test the freezing point calculations + + call EOS_manual_init(EOS_tmp, form_of_TFreeze=TFREEZE_LINEAR, TFr_S0_P0=0.0, dTFr_dS=-0.054, & + dTFr_dP=-7.6e-8) + fail = test_TFr_consistency(35.0, 1.0e7, EOS_tmp, verbose, "LINEAR", TFr_check=-2.65*EOS_tmp%degC_to_C) + if (verbose .and. fail) call MOM_error(WARNING, "LINEAR TFr has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_TFreeze=TFREEZE_MILLERO) + fail = test_TFr_consistency(35.0, 1.0e7, EOS_tmp, verbose, "MILLERO_78", & + TFr_check=-2.69730134114106*EOS_tmp%degC_to_C) + if (verbose .and. fail) call MOM_error(WARNING, "MILLERO_78 TFr has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_TFreeze=TFREEZE_TEOS10) + fail = test_TFr_consistency(35.0, 1.0e7, EOS_tmp, verbose, "TEOS10", & + TFr_check=-2.69099996992861*EOS_tmp%degC_to_C) + if (verbose .and. fail) call MOM_error(WARNING, "TEOS10 TFr has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + call EOS_manual_init(EOS_tmp, form_of_TFreeze=TFREEZE_TEOSPOLY) + fail = test_TFr_consistency(35.0, 1.0e7, EOS_tmp, verbose, "TEOS_POLY", & + TFr_check=-2.691165259327735*EOS_tmp%degC_to_C) + if (verbose .and. fail) call MOM_error(WARNING, "TEOS_POLY TFr has failed some self-consistency tests.") + EOS_unit_tests = EOS_unit_tests .or. fail + + if (verbose .and. .not.EOS_unit_tests) call MOM_mesg("All EOS consistency tests have passed.") + +end function EOS_unit_tests + +logical function test_TS_conversion_consistency(T_cons, S_abs, T_pot, S_prac, EOS, verbose) & + result(inconsistent) + real, intent(in) :: T_cons !< Conservative temperature [degC] + real, intent(in) :: S_abs !< Absolute salinity [g kg-1] + real, intent(in) :: T_pot !< Potential temperature [degC] + real, intent(in) :: S_prac !< Practical salinity [PSU] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + logical, intent(in) :: verbose !< If true, write results to stdout + + ! Local variables + real :: Sabs(1) ! Absolute or reference salinity [g kg-1] + real :: Sprac(1) ! Practical salinity [PSU] + real :: Stest(1) ! A converted salinity [ppt] + real :: Tcons(1) ! Conservative temperature [degC] + real :: Tpot(1) ! Potential temperature [degC] + real :: Ttest(1) ! A converted temperature [degC] + real :: Stol ! Roundoff error on a typical value of salinities [ppt] + real :: Ttol ! Roundoff error on a typical value of temperatures [degC] + logical :: test_OK ! True if a particular test is consistent. + logical :: OK ! True if all checks so far are consistent. + integer :: i, j, n + + OK = .true. + + ! Copy scalar input values into the corresponding arrays + Sabs(1) = S_abs ; Sprac(1) = S_prac ; Tcons(1) = T_cons ; Tpot(1) = T_pot + + ! Set tolerances for the conversions. + Ttol = 2.0 * 400.0*epsilon(Ttol) + Stol = 35.0 * 400.0*epsilon(Stol) + + ! Check that the converted salinities agree + call abs_saln_to_prac_saln(Sabs, Stest, EOS) + test_OK = (abs(Stest(1) - Sprac(1)) <= Stol) + if (verbose) call write_check_msg("MOM6 Sprac", Stest(1), Sprac(1), Stol, test_OK) + OK = OK .and. test_OK + + call prac_saln_to_abs_saln(Sprac, Stest, EOS) + test_OK = (abs(Stest(1) - Sabs(1)) <= Stol) + if (verbose) call write_check_msg("MOM6 Sabs", Stest(1), Sabs(1), Stol, test_OK) + OK = OK .and. test_OK + + call cons_temp_to_pot_temp(Tcons, Sabs, Ttest, EOS) + test_OK = (abs(Ttest(1) - Tpot(1)) <= Ttol) + if (verbose) call write_check_msg("MOM6 Tpot", Ttest(1), Tpot(1), Ttol, test_OK) + OK = OK .and. test_OK + + call pot_temp_to_cons_temp(Tpot, Sabs, Ttest, EOS) + test_OK = (abs(Ttest(1) - Tcons(1)) <= Ttol) + if (verbose) call write_check_msg("MOM6 Tcons", Ttest(1), Tcons(1), Ttol, test_OK) + OK = OK .and. test_OK + + inconsistent = .not.OK +end function test_TS_conversion_consistency + +logical function test_TFr_consistency(S_test, p_test, EOS, verbose, EOS_name, TFr_check) & + result(inconsistent) + real, intent(in) :: S_test !< Salinity or absolute salinity [S ~> ppt] + real, intent(in) :: p_test !< Pressure [R L2 T-2 ~> Pa] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + logical, intent(in) :: verbose !< If true, write results to stdout + character(len=*), intent(in) :: EOS_name !< A name used in error messages to describe the EoS + real, optional, intent(in) :: TFr_check !< A check value for the Freezing point [C ~> degC] + + ! Local variables + real, dimension(-3:3,-3:3) :: S ! Salinities at the test value and perturbed points [S ~> ppt] + real, dimension(-3:3,-3:3) :: P ! Pressures at the test value and perturbed points [R L2 T-2 ~> Pa] + real, dimension(-3:3,-3:3,2) :: TFr ! Freezing point at the test value and perturbed points [C ~> degC] + character(len=200) :: mesg + real :: dS ! Magnitude of salinity perturbations [S ~> ppt] + real :: dp ! Magnitude of pressure perturbations [R L2 T-2 ~> Pa] + ! real :: tol ! The nondimensional tolerance from roundoff [nondim] + real :: TFr_tol ! Roundoff error on a typical value of TFreeze [C ~> degC] + logical :: test_OK ! True if a particular test is consistent. + logical :: OK ! True if all checks so far are consistent. + integer :: i, j, n + + OK = .true. + + dS = 0.5*EOS%ppt_to_S ! Salinity perturbations [S ~> ppt] + dp = 10.0e4 / EOS%RL2_T2_to_Pa ! Pressure perturbations [R L2 T-2 ~> Pa] + + ! TEOS 10 requires a tolerance that is ~20 times larger than other freezing point + ! expressions because it lacks parentheses. + TFr_tol = 2.0*EOS%degC_to_C * 400.0*epsilon(TFr_tol) + + do n=1,2 + ! Calculate density values with a wide enough stencil to estimate first and second derivatives + ! with up to 6th order accuracy. Doing this twice with different sizes of perturbations allows + ! the evaluation of whether the finite differences are converging to the calculated values at a + ! rate that is consistent with the order of accuracy of the finite difference forms, and hence + ! the consistency of the calculated values. + do j=-3,3 ; do i=-3,3 + S(i,j) = max(S_test + n*dS*i, 0.0) + p(i,j) = max(p_test + n*dp*j, 0.0) + enddo ; enddo + do j=-3,3 + call calculate_TFreeze(S(:,j), p(:,j), TFr(:,j,n), EOS) + enddo + enddo + + ! Check that the freezing point agrees with the provided check value + if (present(TFr_check)) then + test_OK = (abs(TFr_check - TFr(0,0,1)) <= TFr_tol) + OK = OK .and. test_OK + if (verbose) call write_check_msg(trim(EOS_name)//" TFr", TFr(0,0,1), TFr_check, Tfr_tol, test_OK) + endif + + inconsistent = .not.OK +end function test_TFr_consistency + +!> Write a message indicating how well a value matches its check value. +subroutine write_check_msg(var_name, val, val_chk, val_tol, test_OK) + character(len=*), intent(in) :: var_name !< The name of the variable being tested. + real, intent(in) :: val !< The value being checked [various] + real, intent(in) :: val_chk !< The value being checked [various] + real, intent(in) :: val_tol !< The value being checked [various] + logical, intent(in) :: test_OK !< True if the values are within their tolerance + + character(len=200) :: mesg + + write(mesg, '(ES24.16," vs. ",ES24.16,", diff=",ES12.4,", tol=",ES12.4)') & + val, val_chk, val-val_chk, val_tol + if (test_OK) then + call MOM_mesg(trim(var_name)//" agrees with its check value :"//trim(mesg)) + else + call MOM_error(WARNING, trim(var_name)//" disagrees with its check value :"//trim(mesg)) + endif +end subroutine write_check_msg + +!> Test an equation of state for self-consistency and consistency with check values, returning false +!! if it is consistent by all tests, and true if it fails any test. +logical function test_EOS_consistency(T_test, S_test, p_test, EOS, verbose, & + EOS_name, rho_check, spv_check, skip_2nd, avg_Sv_check) result(inconsistent) + real, intent(in) :: T_test !< Potential temperature or conservative temperature [C ~> degC] + real, intent(in) :: S_test !< Salinity or absolute salinity [S ~> ppt] + real, intent(in) :: p_test !< Pressure [R L2 T-2 ~> Pa] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + logical, intent(in) :: verbose !< If true, write results to stdout + character(len=*), intent(in) :: EOS_name !< A name used in error messages to describe the EoS + real, optional, intent(in) :: rho_check !< A check value for the density [R ~> kg m-3] + real, optional, intent(in) :: spv_check !< A check value for the specific volume [R-1 ~> m3 kg-1] + logical, optional, intent(in) :: skip_2nd !< If present and true, do not check the 2nd derivatives. + logical, optional, intent(in) :: avg_Sv_check !< If present and true, compare analytical and numerical + !! quadrature estimates of the layer-averaged specific volume. + + ! Local variables + real, dimension(-3:3,-3:3,-3:3) :: T ! Temperatures at the test value and perturbed points [C ~> degC] + real, dimension(-3:3,-3:3,-3:3) :: S ! Salinities at the test value and perturbed points [S ~> ppt] + real, dimension(-3:3,-3:3,-3:3) :: P ! Pressures at the test value and perturbed points [R L2 T-2 ~> Pa] + real, dimension(-3:3,-3:3,-3:3,2) :: rho ! Densities relative to rho_ref at the test value and + ! perturbed points [R ~> kg m-3] + real, dimension(-3:3,-3:3,-3:3,2) :: spv ! Specific volumes relative to spv_ref at the test value and + ! perturbed points [R-1 ~> m3 kg-1] + real :: dT ! Magnitude of temperature perturbations [C ~> degC] + real :: dS ! Magnitude of salinity perturbations [S ~> ppt] + real :: dp ! Magnitude of pressure perturbations [R L2 T-2 ~> Pa] + real :: rho_ref ! A reference density that is extracted for greater accuracy [R ~> kg m-3] + real :: spv_ref ! A reference specific volume that is extracted for greater accuracy [R-1 ~> m3 kg-1] + real :: rho_nooff ! Density with no reference offset [R ~> kg m-3] + real :: spv_nooff ! Specific volume with no reference offset [R-1 ~> m3 kg-1] + real :: drho_dT ! The partial derivative of density with potential + ! temperature [R C-1 ~> kg m-3 degC-1] + real :: drho_dS ! The partial derivative of density with salinity + ! in [R S-1 ~> kg m-3 ppt-1] + real :: drho_dp ! The partial derivative of density with pressure (also the + ! inverse of the square of sound speed) [T2 L-2 ~> s2 m-2] + real :: dSV_dT(1) ! The partial derivative of specific volume with potential + ! temperature [R-1 C-1 ~> m3 kg-1 degC-1] + real :: dSV_dS(1) ! The partial derivative of specific volume with salinity + ! [R-1 S-1 ~> m3 kg-1 ppt-1] + real :: SpV_avg_a(1) ! The pressure-averaged specific volume determined analytically [R-1 ~> m3 kg-1] + real :: SpV_avg_q(1) ! The pressure-averaged specific volume determined via quadrature [R-1 ~> m3 kg-1] + real :: drho_dS_dS ! Second derivative of density with respect to S [R S-2 ~> kg m-3 ppt-2] + real :: drho_dS_dT ! Second derivative of density with respect to T and S [R S-1 C-1 ~> kg m-3 ppt-1 degC-1] + real :: drho_dT_dT ! Second derivative of density with respect to T [R C-2 ~> kg m-3 degC-2] + real :: drho_dS_dP ! Second derivative of density with respect to salinity and pressure + ! [T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1] + real :: drho_dT_dP ! Second derivative of density with respect to temperature and pressure + ! [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] + + real :: drho_dT_fd(2) ! Two 6th order finite difference estimates of the partial derivative of density + ! with potential temperature [R C-1 ~> kg m-3 degC-1] + real :: drho_dS_fd(2) ! Two 6th order finite difference estimates of the partial derivative of density + ! with salinity [R S-1 ~> kg m-3 ppt-1] + real :: drho_dp_fd(2) ! Two 6th order finite difference estimates of the partial derivative of density + ! with pressure (also the inverse of the square of sound speed) [T2 L-2 ~> s2 m-2] + real :: dSV_dT_fd(2) ! Two 6th order finite difference estimates of the partial derivative of + ! specific volume with potential temperature [R-1 C-1 ~> m3 kg-1 degC-1] + real :: dSV_dS_fd(2) ! Two 6th order finite difference estimates of the partial derivative of + ! specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1] + real :: drho_dS_dS_fd(2) ! Two 6th order finite difference estimates of the second derivative of + ! density with respect to salinity [R S-2 ~> kg m-3 ppt-2] + real :: drho_dS_dT_fd(2) ! Two 6th order finite difference estimates of the second derivative of density + ! with respect to temperature and salinity [R S-1 C-1 ~> kg m-3 ppt-1 degC-1] + real :: drho_dT_dT_fd(2) ! Two 6th order finite difference estimates of the second derivative of + ! density with respect to temperature [R C-2 ~> kg m-3 degC-2] + real :: drho_dS_dP_fd(2) ! Two 6th order finite difference estimates of the second derivative of density + ! with respect to salinity and pressure [T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1] + real :: drho_dT_dP_fd(2) ! Two 6th order finite difference estimates of the second derivative of density + ! with respect to temperature and pressure [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] + real :: rho_tmp ! A temporary copy of the situ density [R ~> kg m-3] + real :: tol ! The nondimensional tolerance from roundoff [nondim] + real :: r_tol ! Roundoff error on a typical value of density anomaly [R ~> kg m-3] + real :: sv_tol ! Roundoff error on a typical value of specific volume anomaly [R-1 ~> m3 kg-1] + real :: tol_here ! The tolerance for each check, in various units [various] + real :: T_min, T_max ! The minimum and maximum temperature over which this EoS is fitted [degC] + real :: S_min, S_max ! The minimum and maximum temperature over which this EoS is fitted [ppt] + real :: p_min, p_max ! The minimum and maximum temperature over which this EoS is fitted [Pa] + real :: count_fac ! A factor in the roundoff estimates based on the factors in the numerator and + ! denominator in the finite difference derivative expression [nondim] + real :: count_fac2 ! A factor in the roundoff estimates based on the factors in the numerator and + ! denominator in the finite difference second derivative expression [nondim] + character(len=200) :: mesg + type(EOS_type) :: EOS_tmp + logical :: test_OK ! True if a particular test is consistent. + logical :: OK ! True if all checks so far are consistent. + logical :: test_2nd ! If true, do tests on the 2nd derivative calculations + logical :: test_avg_Sv ! If true, compare numerical and analytical estimates of the vertically + ! averaged specific volume + integer :: order ! The order of accuracy of the centered finite difference estimates (2, 4 or 6). + integer :: i, j, k, n + + test_2nd = .true. ; if (present(skip_2nd)) test_2nd = .not.skip_2nd + test_avg_Sv = .false. ; if (present(avg_Sv_check)) test_avg_Sv = avg_Sv_check + + dT = 0.1*EOS%degC_to_C ! Temperature perturbations [C ~> degC] + dS = 0.5*EOS%ppt_to_S ! Salinity perturbations [S ~> ppt] + dp = 10.0e4 / EOS%RL2_T2_to_Pa ! Pressure perturbations [R L2 T-2 ~> Pa] + + r_tol = 50.0*EOS%kg_m3_to_R * 10.*epsilon(r_tol) + sv_tol = 5.0e-5*EOS%R_to_kg_m3 * 10.*epsilon(sv_tol) + rho_ref = 1000.0*EOS%kg_m3_to_R + spv_ref = 1.0 / rho_ref + + order = 4 ! This should be 2, 4 or 6. + + ! Check whether the consistency test is being applied outside of the value range of this EoS. + call EoS_fit_range(EOS, T_min, T_max, S_min, S_max, p_min, p_max) + if ((T_test < T_min) .or. (T_test > T_max)) then + write(mesg, '(ES12.4," [degC] which is outside of the fit range of ",ES12.4," to ",ES12.4)') T_test, T_min, T_max + call MOM_error(WARNING, trim(EOS_name)//" is being evaluated at a temperature of "//trim(mesg)) + endif + if ((S_test < S_min) .or. (S_test > S_max)) then + write(mesg, '(ES12.4," [ppt] which is outside of the fit range of ",ES12.4," to ",ES12.4)') S_test, S_min, S_max + call MOM_error(WARNING, trim(EOS_name)//" is being evaluated at a salinity of "//trim(mesg)) + endif + if ((p_test < p_min) .or. (p_test > p_max)) then + write(mesg, '(ES12.4," [Pa] which is outside of the fit range of ",ES12.4," to ",ES12.4)') p_test, p_min, p_max + call MOM_error(WARNING, trim(EOS_name)//" is being evaluated at a pressure of "//trim(mesg)) + endif + + do n=1,2 + ! Calculate density values with a wide enough stencil to estimate first and second derivatives + ! with up to 6th order accuracy. Doing this twice with different sizes of perturbations allows + ! the evaluation of whether the finite differences are converging to the calculated values at a + ! rate that is consistent with the order of accuracy of the finite difference forms, and hence + ! the consistency of the calculated values. + do k=-3,3 ; do j=-3,3 ; do i=-3,3 + T(i,j,k) = T_test + n*dT*i + S(i,j,k) = S_test + n*dS*j + p(i,j,k) = p_test + n*dp*k + enddo ; enddo ; enddo + do k=-3,3 ; do j=-3,3 + call calculate_density(T(:,j,k), S(:,j,k), p(:,j,k), rho(:,j,k,n), EOS, rho_ref=rho_ref) + call calculate_spec_vol(T(:,j,k), S(:,j,k), p(:,j,k), spv(:,j,k,n), EOS, spv_ref=spv_ref) + enddo ; enddo + + drho_dT_fd(n) = first_deriv(rho(:,0,0,n), n*dT, order) + drho_dS_fd(n) = first_deriv(rho(0,:,0,n), n*dS, order) + drho_dp_fd(n) = first_deriv(rho(0,0,:,n), n*dp, order) + dSV_dT_fd(n) = first_deriv(spv(:,0,0,n), n*dT, order) + dSV_dS_fd(n) = first_deriv(spv(0,:,0,n), n*dS, order) + if (test_2nd) then + drho_dT_dT_fd(n) = second_deriv(rho(:,0,0,n), n*dT, order) + drho_dS_dS_fd(n) = second_deriv(rho(0,:,0,n), n*dS, order) + drho_dS_dT_fd(n) = derivs_2d(rho(:,:,0,n), n**2*dT*dS, order) + drho_dT_dP_fd(n) = derivs_2d(rho(:,0,:,n), n**2*dT*dP, order) + drho_dS_dP_fd(n) = derivs_2d(rho(0,:,:,n), n**2*dS*dP, order) + endif + enddo + + call calculate_density_derivs(T(0,0,0), S(0,0,0), p(0,0,0), drho_dT, drho_dS, EOS) + ! The first indices here are "0:0" because there is no scalar form of calculate_specific_vol_derivs. + call calculate_specific_vol_derivs(T(0:0,0,0), S(0:0,0,0), p(0:0,0,0), dSV_dT, dSV_dS, EOS) + if (test_2nd) & + call calculate_density_second_derivs(T(0,0,0), S(0,0,0), p(0,0,0), & + drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, EOS) + call calculate_compress(T(0,0,0), S(0,0,0), p(0,0,0), rho_tmp, drho_dp, EOS) + + if (test_avg_Sv) then + EOS_tmp = EOS + call EOS_manual_init(EOS_tmp, EOS_quadrature=.false.) + call average_specific_vol(T(0:0,0,0), S(0:0,0,0), p(0:0,0,0), p(0:0,0,0), SpV_avg_a, EOS_tmp) + call EOS_manual_init(EOS_tmp, EOS_quadrature=.true.) + call average_specific_vol(T(0:0,0,0), S(0:0,0,0), p(0:0,0,0), p(0:0,0,0), SpV_avg_q, EOS_tmp) + endif + + OK = .true. + + tol = 1000.0*epsilon(tol) + + ! Check that the density agrees with the provided check value + if (present(rho_check)) then + test_OK = (abs(rho_check - (rho_ref + rho(0,0,0,1))) < tol*(rho_ref + rho(0,0,0,1))) + OK = OK .and. test_OK + if (verbose) & + call write_check_msg(trim(EOS_name)//" rho", rho_ref+rho(0,0,0,1), rho_check, tol*rho(0,0,0,1), test_OK) + endif + + ! Check that the specific volume agrees with the provided check value or the inverse of density + if (present(spv_check)) then + test_OK = (abs(spv_check - (spv_ref + spv(0,0,0,1))) < tol*abs(spv_ref + spv(0,0,0,1))) + if (verbose) & + call write_check_msg(trim(EOS_name)//" spv", spv_ref+spv(0,0,0,1), spv_check, tol*spv(0,0,0,1), test_OK) + OK = OK .and. test_OK + else + test_OK = (abs((rho_ref+rho(0,0,0,1)) * (spv_ref + spv(0,0,0,1)) - 1.0) < tol) + OK = OK .and. test_OK + if (verbose) then + write(mesg, '(ES16.8," and ",ES16.8,", ratio - 1 = ",ES16.8)') & + rho_ref+rho(0,0,0,1), 1.0/(spv_ref + spv(0,0,0,1)), & + (rho_ref+rho(0,0,0,1)) * (spv_ref + spv(0,0,0,1)) - 1.0 + if (test_OK) then + call MOM_mesg("The values of "//trim(EOS_name)//" rho and 1/spv agree. "//trim(mesg)) + else + call MOM_error(WARNING, "The values of "//trim(EOS_name)//" rho and 1/spv disagree. "//trim(mesg)) + endif + endif + endif + + ! Check that the densities are consistent when the reference value is extracted + call calculate_density(T(0,0,0), S(0,0,0), p(0,0,0), rho_nooff, EOS) + test_OK = (abs(rho_nooff - (rho_ref + rho(0,0,0,1))) < tol*rho_nooff) + OK = OK .and. test_OK + if (verbose .and. .not.test_OK) then + write(mesg, '(ES24.16," vs. ",ES24.16," with tolerance ",ES12.4)') & + rho_ref+rho(0,0,0,1), rho_nooff, tol*rho_nooff + call MOM_error(WARNING, "For "//trim(EOS_name)//& + " rho with and without a reference value disagree: "//trim(mesg)) + endif + + ! Check that the specific volumes are consistent when the reference value is extracted + call calculate_spec_vol(T(0,0,0), S(0,0,0), p(0,0,0), spv_nooff, EOS) + test_OK = (abs(spv_nooff - (spv_ref + spv(0,0,0,1))) < tol*rho_nooff) + OK = OK .and. test_OK + if (verbose .and. .not.test_OK) then + write(mesg, '(ES24.16," vs. ",ES24.16," with tolerance ",ES12.4)') & + spv_ref + spv(0,0,0,1), spv_nooff, tol*spv_nooff + call MOM_error(WARNING, "For "//trim(EOS_name)//& + " spv with and without a reference value disagree: "//trim(mesg)) + endif + + ! Account for the factors of terms in the numerator and denominator when estimating roundoff + if (order == 6) then + count_fac = 110.0/60.0 ; count_fac2 = 1088.0/180.0 + elseif (order == 4) then ! Use values appropriate for 4th order schemes. + count_fac = 18.0/12.0 ; count_fac2 = 64.0/12.0 + else ! Use values appropriate for 2nd order schemes. + count_fac = 2.0/2.0 ; count_fac2 = 4.0 + endif + + ! Check for the rate of convergence expected with a 4th or 6th order accurate discretization + ! with a 20% margin of error and a tolerance for contributions from roundoff. + tol_here = tol*abs(drho_dT) + count_fac*r_tol/dT + OK = OK .and. check_FD(drho_dT, drho_dT_fd, tol_here, verbose, trim(EOS_name)//" drho_dT", order) + tol_here = tol*abs(drho_dS) + count_fac*r_tol/dS + OK = OK .and. check_FD(drho_dS, drho_dS_fd, tol_here, verbose, trim(EOS_name)//" drho_dS", order) + tol_here = tol*abs(drho_dp) + count_fac*r_tol/dp + OK = OK .and. check_FD(drho_dp, drho_dp_fd, tol_here, verbose, trim(EOS_name)//" drho_dp", order) + tol_here = tol*abs(dSV_dT(1)) + count_fac*sv_tol/dT + OK = OK .and. check_FD(dSV_dT(1), dSV_dT_fd, tol_here, verbose, trim(EOS_name)//" dSV_dT", order) + tol_here = tol*abs(dSV_dS(1)) + count_fac*sv_tol/dS + OK = OK .and. check_FD(dSV_dS(1), dSV_dS_fd, tol_here, verbose, trim(EOS_name)//" dSV_dS", order) + if (test_2nd) then + tol_here = tol*abs(drho_dT_dT) + count_fac2*r_tol/dT**2 + OK = OK .and. check_FD(drho_dT_dT, drho_dT_dT_fd, tol_here, verbose, trim(EOS_name)//" drho_dT_dT", order) + ! The curvature in salinity is relatively weak, so looser tolerances are needed for some forms of EOS? + tol_here = 10.0*(tol*abs(drho_dS_dS) + count_fac2*r_tol/dS**2) + OK = OK .and. check_FD(drho_dS_dS, drho_dS_dS_fd, tol_here, verbose, trim(EOS_name)//" drho_dS_dS", order) + tol_here = tol*abs(drho_dS_dT) + count_fac**2*r_tol/(dS*dT) + OK = OK .and. check_FD(drho_dS_dT, drho_dS_dT_fd, tol_here, verbose, trim(EOS_name)//" drho_dS_dT", order) + tol_here = tol*abs(drho_dT_dP) + count_fac**2*r_tol/(dT*dp) + OK = OK .and. check_FD(drho_dT_dP, drho_dT_dP_fd, tol_here, verbose, trim(EOS_name)//" drho_dT_dP", order) + tol_here = tol*abs(drho_dS_dP) + count_fac**2*r_tol/(dS*dp) + OK = OK .and. check_FD(drho_dS_dP, drho_dS_dP_fd, tol_here, verbose, trim(EOS_name)//" drho_dS_dP", order) + endif + + if (test_avg_Sv) then + tol_here = 0.5*tol*(abs(SpV_avg_a(1)) + abs(SpV_avg_q(1))) + test_OK = (abs(SpV_avg_a(1) - SpV_avg_q(1)) < tol_here) + if (verbose) then + write(mesg, '(ES24.16," and ",ES24.16," differ by ",ES16.8," (",ES10.2"), tol=",ES16.8)') & + SpV_avg_a(1), SpV_avg_q(1), SpV_avg_a(1) - SpV_avg_q(1), & + 2.0*(SpV_avg_a(1) - SpV_avg_q(1)) / (abs(SpV_avg_a(1)) + abs(SpV_avg_q(1)) + tiny(SpV_avg_a(1))), & + tol_here + if (verbose .and. .not.test_OK) then + call MOM_error(WARNING, "The values of "//trim(EOS_name)//" SpV_avg disagree. "//trim(mesg)) + elseif (verbose) then + call MOM_mesg("The values of "//trim(EOS_name)//" SpV_avg agree: "//trim(mesg)) + endif + endif + OK = OK .and. test_OK + endif + + inconsistent = .not.OK + + contains + + !> Return a finite difference estimate of the first derivative of a field in arbitrary units [A B-1] + real function first_deriv(R, dx, order) + real, intent(in) :: R(-3:3) !< The field whose derivative is being taken, in arbitrary units [A] + real, intent(in) :: dx !< The spacing in parameter space, in different arbitrary units [B] + integer, intent(in) :: order !< The order of accuracy of the centered finite difference estimates (2, 4 or 6) + + if (order == 6) then ! Find a 6th order accurate first derivative on a regular grid. + first_deriv = (45.0*(R(1)-R(-1)) + (-9.0*(R(2)-R(-2)) + (R(3)-R(-3))) ) / (60.0 * dx) + elseif (order == 4) then ! Find a 4th order accurate first derivative on a regular grid. + first_deriv = (8.0*(R(1)-R(-1)) - (R(2)-R(-2)) ) / (12.0 * dx) + else ! Find a 2nd order accurate first derivative on a regular grid. + first_deriv = (R(1)-R(-1)) / (2.0 * dx) + endif + end function first_deriv + + !> Return a finite difference estimate of the second derivative of a field in arbitrary units [A B-2] + real function second_deriv(R, dx, order) + real, intent(in) :: R(-3:3) !< The field whose derivative is being taken, in arbitrary units [A] + real, intent(in) :: dx !< The spacing in parameter space, in different arbitrary units [B] + integer, intent(in) :: order !< The order of accuracy of the centered finite difference estimates (2, 4 or 6) + + if (order == 6) then ! Find a 6th order accurate second derivative on a regular grid. + second_deriv = ( -490.0*R(0) + (270.0*(R(1)+R(-1)) + (-27.0*(R(2)+R(-2)) + 2.0*(R(3)+R(-3))) )) / (180.0 * dx**2) + elseif (order == 4) then ! Find a 4th order accurate second derivative on a regular grid. + second_deriv = ( -30.0*R(0) + (16.0*(R(1)+R(-1)) - (R(2)+R(-2))) ) / (12.0 * dx**2) + else ! Find a 2nd order accurate second derivative on a regular grid. + second_deriv = ( -2.0*R(0) + (R(1)+R(-1)) ) / dx**2 + endif + end function second_deriv + + !> Return a finite difference estimate of the second derivative with respect to two different + !! parameters of a field in arbitrary units [A B-1 C-1] + real function derivs_2d(R, dxdy, order) + real, intent(in) :: R(-3:3,-3:3) !< The field whose derivative is being taken in arbitrary units [A] + real, intent(in) :: dxdy !< The spacing in two directions in parameter space in different arbitrary units [B C] + integer, intent(in) :: order !< The order of accuracy of the centered finite difference estimates (2, 4 or 6) + + real :: dRdx(-3:3) ! The first derivative in one direction times the grid spacing in that direction [A] + integer :: i + + do i=-3,3 + dRdx(i) = first_deriv(R(:,i), 1.0, order) + enddo + derivs_2d = first_deriv(dRdx, dxdy, order) + + end function derivs_2d + + !> Check for the rate of convergence expected with a finite difference discretization + !! with a 20% margin of error and a tolerance for contributions from roundoff. + logical function check_FD(val, val_fd, tol, verbose, field_name, order) + real, intent(in) :: val !< The derivative being checked, in arbitrary units [arbitrary] + real, intent(in) :: val_fd(2) !< Two finite difference estimates of val taken with a spacing + !! in parameter space and twice this spacing, in the same + !! arbitrary units as val [arbitrary] + real, intent(in) :: tol !< An estimated fractional tolerance due to roundoff [arbitrary] + logical, intent(in) :: verbose !< If true, write results to stdout + character(len=*), intent(in) :: field_name !< A name used to describe the field in error messages + integer, intent(in) :: order !< The order of accuracy of the centered finite difference estimates (2, 4 or 6) + + character(len=200) :: mesg + + check_FD = ( abs(val_fd(1) - val) < (1.2*abs(val_fd(2) - val)/2**order + abs(tol)) ) + + ! write(mesg, '(ES16.8," and ",ES16.8," differ by ",ES16.8," (",ES10.2"), tol=",ES16.8)') & + write(mesg, '(ES24.16," and ",ES24.16," differ by ",ES16.8," (",ES10.2"), tol=",ES16.8)') & + val, val_fd(1), val - val_fd(1), & + 2.0*(val - val_fd(1)) / (abs(val) + abs(val_fd(1)) + tiny(val)), & + (1.2*abs(val_fd(2) - val)/2**order + abs(tol)) + ! This message is useful for debugging the two estimates: + ! write(mesg, '(ES16.8," and ",ES16.8," or ",ES16.8," differ by ",2ES16.8," (",2ES10.2"), tol=",ES16.8)') & + ! val, val_fd(1), val_fd(2), val - val_fd(1), val - val_fd(2), & + ! 2.0*(val - val_fd(1)) / (abs(val) + abs(val_fd(1)) + tiny(val)), & + ! 2.0*(val - val_fd(2)) / (abs(val) + abs(val_fd(2)) + tiny(val)), & + ! (1.2*abs(val_fd(2) - val)/2**order + abs(tol)) + if (verbose .and. .not.check_FD) then + call MOM_error(WARNING, "The values of "//trim(field_name)//" disagree. "//trim(mesg)) + elseif (verbose) then + call MOM_mesg("The values of "//trim(field_name)//" agree: "//trim(mesg)) + endif + end function check_FD + +end function test_EOS_consistency + end module MOM_EOS !> \namespace mom_eos !! -!! The MOM_EOS module is a wrapper for various equations of state (e.g. Linear, -!! Wright, UNESCO) and provides a uniform interface to the rest of the model -!! independent of which equation of state is being used. +!! The MOM_EOS module is a wrapper for various equations of state (i.e. Linear, Wright, +!! Wright_full, Wright_red, UNESCO, TEOS10, Roquet_SpV or Roquet_rho) and provides a uniform +!! interface to the rest of the model independent of which equation of state is being used. diff --git a/src/equation_of_state/MOM_EOS_Jackett06.F90 b/src/equation_of_state/MOM_EOS_Jackett06.F90 new file mode 100644 index 0000000000..119edee4f0 --- /dev/null +++ b/src/equation_of_state/MOM_EOS_Jackett06.F90 @@ -0,0 +1,590 @@ +!> The equation of state using the Jackett et al 2006 expressions that are often used in Hycom +module MOM_EOS_Jackett06 + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_hor_index, only : hor_index_type + +implicit none ; private + +public calculate_compress_Jackett06, calculate_density_Jackett06, calculate_spec_vol_Jackett06 +public calculate_density_derivs_Jackett06, calculate_specvol_derivs_Jackett06 +public calculate_density_second_derivs_Jackett06, EoS_fit_range_Jackett06 + +!> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to +!! a reference density, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Jackett et al., 2006, J. Atmos. Ocean. Tech., 32, 1709-1728. +interface calculate_density_Jackett06 + module procedure calculate_density_scalar_Jackett, calculate_density_array_Jackett +end interface calculate_density_Jackett06 + +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect +!! to a reference specific volume, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Jackett et al., 2006, J. Atmos. Ocean. Tech., 32, 1709-1728. +interface calculate_spec_vol_Jackett06 + module procedure calculate_spec_vol_scalar_Jackett, calculate_spec_vol_array_Jackett +end interface calculate_spec_vol_Jackett06 + +!> Compute the derivatives of density with temperature and salinity +interface calculate_density_derivs_Jackett06 + module procedure calculate_density_derivs_scalar_Jackett, calculate_density_derivs_array_Jackett +end interface calculate_density_derivs_Jackett06 + +!> Compute the second derivatives of density with various combinations +!! of temperature, salinity, and pressure +interface calculate_density_second_derivs_Jackett06 + module procedure calculate_density_second_derivs_scalar_Jackett, calculate_density_second_derivs_array_Jackett +end interface calculate_density_second_derivs_Jackett06 + +!>@{ Parameters in the Jackett et al. equation of state, which is a fit to the Fiestel (2003) +! equation of state for the range: -2 < theta < 40 [degC], 0 < S < 42 [PSU], 0 < p < 1e8 [Pa]. +! The notation here is for terms in the numerator of the expression for density of +! RNabc for terms proportional to S**a * T**b * P**c, and terms in the denominator as RDabc. +! For terms proportional to S**1.5, 6 is used in this notation. + +! --- coefficients for 25-term rational function sigloc(). +real, parameter :: & + RN000 = 9.9984085444849347d+02, & ! Density numerator constant coefficient [kg m-3] + RN001 = 1.1798263740430364d-06, & ! Density numerator P coefficient [kg m-3 Pa-1] + RN002 = -2.5862187075154352d-16, & ! Density numerator P^2 coefficient [kg m-3 Pa-2] + RN010 = 7.3471625860981584d+00, & ! Density numerator T coefficient [kg m-3 degC-1] + RN020 = -5.3211231792841769d-02, & ! Density numerator T^2 coefficient [kg m-3 degC-2] + RN021 = 9.8920219266399117d-12, & ! Density numerator T^2 P coefficient [kg m-3 degC-2 Pa-1] + RN022 = -3.2921414007960662d-20, & ! Density numerator T^2 P^2 coefficient [kg m-3 degC-2 Pa-2] + RN030 = 3.6492439109814549d-04, & ! Density numerator T^3 coefficient [kg m-3 degC-3] + RN100 = 2.5880571023991390d+00, & ! Density numerator S coefficient [kg m-3 PSU-1] + RN101 = 4.6996642771754730d-10, & ! Density numerator S P coefficient [kg m-3 PSU-1 Pa-1] + RN110 = -6.7168282786692355d-03, & ! Density numerator S T coefficient [kg m-3 degC-1 PSU-1] + RN200 = 1.9203202055760151d-03, & ! Density numerator S^2 coefficient [kg m-3] + + RD001 = 6.7103246285651894d-10, & ! Density denominator P coefficient [Pa-1] + RD010 = 7.2815210113327091d-03, & ! Density denominator T coefficient [degC-1] + RD013 = -9.1534417604289062d-30, & ! Density denominator T P^3 coefficient [degC-1 Pa-3] + RD020 = -4.4787265461983921d-05, & ! Density denominator T^2 coefficient [degC-2] + RD030 = 3.3851002965802430d-07, & ! Density denominator T^3 coefficient [degC-3] + RD032 = -2.4461698007024582d-25, & ! Density denominator T^3 P^2 coefficient [degC-3 Pa-2] + RD040 = 1.3651202389758572d-10, & ! Density denominator T^4 coefficient [degC-4] + RD100 = 1.7632126669040377d-03, & ! Density denominator S coefficient [PSU-1] + RD110 = -8.8066583251206474d-06, & ! Density denominator S T coefficient [degC-1 PSU-1] + RD130 = -1.8832689434804897d-10, & ! Density denominator S T^3 coefficient [degC-3 PSU-1] + RD600 = 5.7463776745432097d-06, & ! Density denominator S^1.5 coefficient [PSU-1.5] + RD620 = 1.4716275472242334d-09 ! Density denominator S^1.5 T^2 coefficient [degC-2 PSU-1.5] +!>@} + +contains + +!> Computes the in situ density of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]), and pressure [Pa]. It uses the expression from +!! Jackett et al., 2006, J. Atmos. Ocean. Tech., 32, 1709-1728. +subroutine calculate_density_array_Jackett(T, S, pres, rho, start, npts, rho_ref) + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: pres !< Pressure [Pa]. + real, dimension(:), intent(inout) :: rho !< In situ density [kg m-3]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real :: num_STP ! State dependent part of the numerator of the rational expresion + ! for density [kg m-3] + real :: den ! Denominator of the rational expresion for density [nondim] + real :: den_STP ! State dependent part of the denominator of the rational expresion + ! for density [nondim] + real :: I_den ! The inverse of the denominator of the rational expresion for density [nondim] + real :: T2 ! Temperature squared [degC2] + real :: S1_2 ! Limited square root of salinity [PSU1/2] + real :: rho0 ! The surface density of fresh water at 0 degC, perhaps less the refernce density [kg m-3] + integer :: j + + do j=start,start+npts-1 + S1_2 = sqrt(max(0.0,s(j))) + T2 = T(j)*T(j) + + num_STP = (T(j)*(RN010 + T(j)*(RN020 + T(j)*RN030)) + & + S(j)*(RN100 + (T(j)*RN110 + S(j)*RN200)) ) + & + pres(j)*(RN001 + ((T2*RN021 + S(j)*RN101) + pres(j)*(RN002 + T2*RN022))) + den = 1.0 + ((T(j)*(RD010 + T(j)*(RD020 + T(j)*(RD030 + T(j)* RD040))) + & + S(j)*(RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(RD600 + T2*RD620))) ) + & + pres(j)*(RD001 + pres(j)*T(j)*(T2*RD032 + pres(j)*RD013)) ) + I_den = 1.0 / den + + rho0 = RN000 + if (present(rho_ref)) rho0 = RN000 - rho_ref*den + + rho(j) = (rho0 + num_STP)*I_den + enddo + +end subroutine calculate_density_array_Jackett + +!> Computes the Jackett et al. in situ specific volume of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Jackett et al., 2006, J. Atmos. Ocean. Tech., 32, 1709-1728. +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_array_Jackett(T, S, pres, specvol, start, npts, spv_ref) + real, dimension(:), intent(in) :: T !< potential temperature relative to the + !! surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pres !< pressure [Pa]. + real, dimension(:), intent(inout) :: specvol !< in situ specific volume [m3 kg-1]. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + + ! Local variables + real :: num_STP ! State dependent part of the numerator of the rational expresion + ! for density (not specific volume) [kg m-3] + real :: den_STP ! State dependent part of the denominator of the rational expresion + ! for density (not specific volume) [nondim] + real :: I_num ! The inverse of the numerator of the rational expresion for density [nondim] + real :: T2 ! Temperature squared [degC2] + real :: S1_2 ! Limited square root of salinity [PSU1/2] + integer :: j + + do j=start,start+npts-1 + S1_2 = sqrt(max(0.0,s(j))) + T2 = T(j)*T(j) + + num_STP = (T(j)*(RN010 + T(j)*(RN020 + T(j)*RN030)) + & + S(j)*(RN100 + (T(j)*RN110 + S(j)*RN200)) ) + & + pres(j)*(RN001 + ((T2*RN021 + S(j)*RN101) + pres(j)*(RN002 + T2*RN022))) + den_STP = (T(j)*(RD010 + T(j)*(RD020 + T(j)*(RD030 + T(j)* RD040))) + & + S(j)*(RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(RD600 + T2*RD620))) ) + & + pres(j)*(RD001 + pres(j)*T(j)*(T2*RD032 + pres(j)*RD013)) + I_num = 1.0 / (RN000 + num_STP) + if (present(spv_ref)) then + ! This form is slightly more complicated, but it cancels the leading terms better. + specvol(j) = ((1.0 - spv_ref*RN000) + (den_STP - spv_ref*num_STP)) * I_num + else + specvol(j) = (1.0 + den_STP) * I_num + endif + enddo + +end subroutine calculate_spec_vol_array_Jackett + +!> Return the thermal/haline expansion coefficients for 1-d array inputs and outputs +subroutine calculate_density_derivs_array_Jackett(T, S, pres, drho_dT, drho_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the + !! surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pres !< pressure [Pa]. + real, intent(inout), dimension(:) :: drho_dT !< The partial derivative of density with potential + !! temperature [kg m-3 degC-1]. + real, intent(inout), dimension(:) :: drho_dS !< The partial derivative of density with salinity, + !! in [kg m-3 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: num ! Numerator of the rational expresion for density [kg m-3] + real :: den ! Denominator of the rational expresion for density [nondim] + real :: I_denom2 ! The inverse of the square of the denominator of the rational expression + ! for density [nondim] + real :: dnum_dT ! The derivative of num with potential temperature [kg m-3 degC-1] + real :: dnum_dS ! The derivative of num with salinity [kg m-3 PSU-1] + real :: dden_dT ! The derivative of den with potential temperature [degC-1] + real :: dden_dS ! The derivative of den with salinity PSU-1] + real :: T2 ! Temperature squared [degC2] + real :: S1_2 ! Limited square root of salinity [PSU1/2] + integer :: j + + do j=start,start+npts-1 + S1_2 = sqrt(max(0.0,s(j))) + T2 = T(j)*T(j) + + num = RN000 + ((T(j)*(RN010 + T(j)*(RN020 + T(j)*RN030)) + & + S(j)*(RN100 + (T(j)*RN110 + S(j)*RN200)) ) + & + pres(j)*(RN001 + ((T2*RN021 + S(j)*RN101) + pres(j)*(RN002 + T2*RN022))) ) + den = 1.0 + ((T(j)*(RD010 + T(j)*(RD020 + T(j)*(RD030 + T(j)* RD040))) + & + S(j)*(RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(RD600 + T2*RD620))) ) + & + pres(j)*(RD001 + pres(j)*T(j)*(T2*RD032 + pres(j)*RD013)) ) + + dnum_dT = ((RN010 + T(j)*(2.*RN020 + T(j)*(3.*RN030))) + S(j)*RN110) + & + pres(j)*T(j)*(2.*RN021 + pres(j)*(2.*RN022)) + dnum_dS = (RN100 + (T(j)*RN110 + S(j)*(2.*RN200))) + pres(j)*RN101 + dden_dT = ((RD010 + T(j)*((2.*RD020) + T(j)*((3.*RD030) + T(j)*(4.*RD040)))) + & + S(j)*((RD110 + T2*(3.*RD130)) + S1_2*T(j)*(2.*RD620)) ) + & + pres(j)**2*(T2*3.*RD032 + pres(j)*RD013) + dden_dS = RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(1.5*RD600 + T2*(1.5*RD620))) + I_denom2 = 1.0 / den**2 + + ! rho(j) = num / den + drho_dT(j) = (dnum_dT * den - num * dden_dT) * I_denom2 + drho_dS(j) = (dnum_dS * den - num * dden_dS) * I_denom2 + enddo + +end subroutine calculate_density_derivs_array_Jackett + +!> Return the partial derivatives of specific volume with temperature and salinity +!! for 1-d array inputs and outputs +subroutine calculate_specvol_derivs_Jackett06(T, S, pres, dSV_dT, dSV_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pres !< Pressure [Pa]. + real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! potential temperature [m3 kg-1 degC-1]. + real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! salinity [m3 kg-1 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: num ! Numerator of the rational expresion for density (not specific volume) [kg m-3] + real :: den ! Denominator of the rational expresion for density (not specific volume) [nondim] + real :: I_num2 ! The inverse of the square of the numerator of the rational expression + ! for density [nondim] + real :: dnum_dT ! The derivative of num with potential temperature [kg m-3 degC-1] + real :: dnum_dS ! The derivative of num with salinity [kg m-3 PSU-1] + real :: dden_dT ! The derivative of den with potential temperature [degC-1] + real :: dden_dS ! The derivative of den with salinity PSU-1] + real :: T2 ! Temperature squared [degC2] + real :: S1_2 ! Limited square root of salinity [PSU1/2] + integer :: j + + do j=start,start+npts-1 + S1_2 = sqrt(max(0.0,s(j))) + T2 = T(j)*T(j) + + num = RN000 + ((T(j)*(RN010 + T(j)*(RN020 + T(j)*RN030)) + & + S(j)*(RN100 + (T(j)*RN110 + S(j)*RN200)) ) + & + pres(j)*(RN001 + ((T2*RN021 + S(j)*RN101) + pres(j)*(RN002 + T2*RN022))) ) + den = 1.0 + ((T(j)*(RD010 + T(j)*(RD020 + T(j)*(RD030 + T(j)* RD040))) + & + S(j)*(RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(RD600 + T2*RD620))) ) + & + pres(j)*(RD001 + pres(j)*T(j)*(T2*RD032 + pres(j)*RD013)) ) + + dnum_dT = ((RN010 + T(j)*(2.*RN020 + T(j)*(3.*RN030))) + S(j)*RN110) + & + pres(j)*T(j)*(2.*RN021 + pres(j)*(2.*RN022)) + dnum_dS = (RN100 + (T(j)*RN110 + S(j)*(2.*RN200))) + pres(j)*RN101 + dden_dT = ((RD010 + T(j)*((2.*RD020) + T(j)*((3.*RD030) + T(j)*(4.*RD040)))) + & + S(j)*((RD110 + T2*(3.*RD130)) + S1_2*T(j)*(2.*RD620)) ) + & + pres(j)**2*(T2*3.*RD032 + pres(j)*RD013) + dden_dS = RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(1.5*RD600 + T2*(1.5*RD620))) + I_num2 = 1.0 / num**2 + + ! SV(j) = den / num + dSV_dT(j) = (num * dden_dT - dnum_dT * den) * I_num2 + dSV_dS(j) = (num * dden_dS - dnum_dS * den) * I_num2 + enddo + +end subroutine calculate_specvol_derivs_Jackett06 + +!> Computes the compressibility of seawater for 1-d array inputs and outputs +subroutine calculate_compress_Jackett06(T, S, pres, rho, drho_dp, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pres !< Pressure [Pa]. + real, intent(inout), dimension(:) :: rho !< In situ density [kg m-3]. + real, intent(inout), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! [s2 m-2]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: num ! Numerator of the rational expresion for density [kg m-3] + real :: den ! Denominator of the rational expresion for density [nondim] + real :: I_den ! The inverse of the denominator of the rational expression for density [nondim] + real :: dnum_dp ! The derivative of num with pressure [kg m-3 dbar-1] + real :: dden_dp ! The derivative of den with pressure [dbar-1] + real :: T2 ! Temperature squared [degC2] + real :: S1_2 ! Limited square root of salinity [PSU1/2] + integer :: j + + do j=start,start+npts-1 + S1_2 = sqrt(max(0.0,s(j))) + T2 = T(j)*T(j) + + num = RN000 + ((T(j)*(RN010 + T(j)*(RN020 + T(j)*RN030)) + & + S(j)*(RN100 + (T(j)*RN110 + S(j)*RN200)) ) + & + pres(j)*(RN001 + ((T2*RN021 + S(j)*RN101) + pres(j)*(RN002 + T2*RN022))) ) + den = 1.0 + ((T(j)*(RD010 + T(j)*(RD020 + T(j)*(RD030 + T(j)* RD040))) + & + S(j)*(RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(RD600 + T2*RD620))) ) + & + pres(j)*(RD001 + pres(j)*T(j)*(T2*RD032 + pres(j)*RD013)) ) + dnum_dp = RN001 + ((T2*RN021 + S(j)*RN101) + pres(j)*(2.*RN002 + T2*(2.*RN022))) + dden_dp = RD001 + pres(j)*T(j)*(T2*(2.*RD032) + pres(j)*(3.*RD013)) + + I_den = 1.0 / den + rho(j) = num * I_den + drho_dp(j) = (dnum_dp * den - num * dden_dp) * I_den**2 + enddo +end subroutine calculate_compress_Jackett06 + +!> Second derivatives of density with respect to temperature, salinity, and pressure for 1-d array inputs and outputs. +subroutine calculate_density_second_derivs_array_Jackett(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] + real, dimension(:), intent(in ) :: S !< Salinity [PSU] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< Starting index in T,S,P + integer, intent(in ) :: npts !< Number of points to loop over + + ! Local variables + real :: num ! Numerator of the rational expresion for density [kg m-3] + real :: den ! Denominator of the rational expresion for density [nondim] + real :: I_num2 ! The inverse of the square of the numerator of the rational expression + ! for density [nondim] + real :: dnum_dT ! The derivative of num with potential temperature [kg m-3 degC-1] + real :: dnum_dS ! The derivative of num with salinity [kg m-3 PSU-1] + real :: dden_dT ! The derivative of den with potential temperature [degC-1] + real :: dden_dS ! The derivative of den with salinity PSU-1] + real :: dnum_dp ! The derivative of num with pressure [kg m-3 dbar-1] + real :: dden_dp ! The derivative of det with pressure [dbar-1] + real :: d2num_dT2 ! The second derivative of num with potential temperature [kg m-3 degC-2] + real :: d2num_dT_dS ! The second derivative of num with potential temperature and + ! salinity [kg m-3 degC-1 PSU-1] + real :: d2num_dS2 ! The second derivative of num with salinity [kg m-3 PSU-2] + real :: d2num_dT_dp ! The second derivative of num with potential temperature and + ! pressure [kg m-3 degC-1 dbar-1] + real :: d2num_dS_dp ! The second derivative of num with salinity and + ! pressure [kg m-3 PSU-1 dbar-1] + real :: d2den_dT2 ! The second derivative of den with potential temperature [degC-2] + real :: d2den_dT_dS ! The second derivative of den with potential temperature and salinity [degC-1 PSU-1] + real :: d2den_dS2 ! The second derivative of den with salinity [PSU-2] + real :: d2den_dT_dp ! The second derivative of den with potential temperature and pressure [degC-1 dbar-1] + real :: d2den_dS_dp ! The second derivative of den with salinity and pressure [PSU-1 dbar-1] + real :: T2 ! Temperature squared [degC2] + real :: S1_2 ! Limited square root of salinity [PSU1/2] + real :: I_s12 ! The inverse of the square root of salinity [PSU-1/2] + real :: I_denom2 ! The inverse of the square of the denominator of the rational expression + ! for density [nondim] + real :: I_denom3 ! The inverse of the cube of the denominator of the rational expression + ! for density [nondim] + integer :: j + + do j = start,start+npts-1 + S1_2 = sqrt(max(0.0,s(j))) + T2 = T(j)*T(j) + + num = RN000 + ((T(j)*(RN010 + T(j)*(RN020 + T(j)*RN030)) + & + S(j)*(RN100 + (T(j)*RN110 + S(j)*RN200)) ) + & + P(j)*(RN001 + ((T2*RN021 + S(j)*RN101) + P(j)*(RN002 + T2*RN022))) ) + den = 1.0 + ((T(j)*(RD010 + T(j)*(RD020 + T(j)*(RD030 + T(j)* RD040))) + & + S(j)*(RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(RD600 + T2*RD620))) ) + & + P(j)*(RD001 + P(j)*T(j)*(T2*RD032 + P(j)*RD013)) ) + ! rho(j) = num*I_den + + dnum_dT = ((RN010 + T(j)*(2.*RN020 + T(j)*(3.*RN030))) + S(j)*RN110) + & + P(j)*T(j)*(2.*RN021 + P(j)*(2.*RN022)) + dnum_dS = (RN100 + (T(j)*RN110 + S(j)*(2.*RN200))) + P(j)*RN101 + dnum_dp = RN001 + ((T2*RN021 + S(j)*RN101) + P(j)*(2.*RN002 + T2*(2.*RN022))) + d2num_dT2 = 2.*RN020 + T(j)*(6.*RN030) + P(j)*(2.*RN021 + P(j)*(2.*RN022)) + d2num_dT_dS = RN110 + d2num_dS2 = 2.*RN200 + d2num_dT_dp = T(j)*(2.*RN021 + P(j)*(4.*RN022)) + d2num_dS_dp = RN101 + + dden_dT = ((RD010 + T(j)*((2.*RD020) + T(j)*((3.*RD030) + T(j)*(4.*RD040)))) + & + S(j)*((RD110 + T2*(3.*RD130)) + S1_2*T(j)*(2.*RD620)) ) + & + P(j)**2*(T2*3.*RD032 + P(j)*RD013) + dden_dS = RD100 + (T(j)*(RD110 + T2*RD130) + S1_2*(1.5*RD600 + T2*(1.5*RD620))) + dden_dp = RD001 + P(j)*T(j)*(T2*(2.*RD032) + P(j)*(3.*RD013)) + + d2den_dT2 = (((2.*RD020) + T(j)*((6.*RD030) + T(j)*(12.*RD040))) + & + S(j)*(T(j)*(6.*RD130) + S1_2*(2.*RD620)) ) + P(j)**2*(T(j)*(6.*RD032)) + d2den_dT_dS = (RD110 + T2*3.*RD130) + (T(j)*S1_2)*(3.0*RD620) + d2den_dT_dp = P(j)*(T2*(6.*RD032) + P(j)*(3.*RD013)) + d2den_dS_dp = 0.0 + + ! The Jackett et al. 2006 equation of state is a fit to density, but it chooses a form that + ! exhibits a singularity in the second derivatives with salinity for fresh water. To avoid + ! this, the square root of salinity can be treated with a floor such that the contribution from + ! the S**1.5 terms to both the surface density and the secant bulk modulus are lost to roundoff. + ! This salinity is given by (~1e-16/RD600)**(2/3) ~= 7e-8 PSU, or S1_2 ~= 2.6e-4 + I_S12 = 1.0 / (max(S1_2, 1.0e-4)) + d2den_dS2 = (0.75*RD600 + T2*(0.75*RD620)) * I_S12 + + I_denom3 = 1.0 / den**3 + + ! In deriving the following, it is useful to note that: + ! drho_dp(j) = (dnum_dp * den - num * dden_dp) / den**2 + ! drho_dT(j) = (dnum_dT * den - num * dden_dT) / den**2 + ! drho_dS(j) = (dnum_dS * den - num * dden_dS) / den**2 + drho_dS_dS(j) = (den*(den*d2num_dS2 - 2.*dnum_dS*dden_dS) + num*(2.*dden_dS**2 - den*d2den_dS2)) * I_denom3 + drho_dS_dt(j) = (den*(den*d2num_dT_dS - (dnum_dT*dden_dS + dnum_dS*dden_dT)) + & + num*(2.*dden_dT*dden_dS - den*d2den_dT_dS)) * I_denom3 + drho_dT_dT(j) = (den*(den*d2num_dT2 - 2.*dnum_dT*dden_dT) + num*(2.*dden_dT**2 - den*d2den_dT2)) * I_denom3 + + drho_dS_dp(j) = (den*(den*d2num_dS_dp - (dnum_dp*dden_dS + dnum_dS*dden_dp)) + & + num*(2.*dden_dS*dden_dp - den*d2den_dS_dp)) * I_denom3 + drho_dT_dp(j) = (den*(den*d2num_dT_dp - (dnum_dp*dden_dT + dnum_dT*dden_dp)) + & + num*(2.*dden_dT*dden_dp - den*d2den_dT_dp)) * I_denom3 + enddo + +end subroutine calculate_density_second_derivs_array_Jackett + +!> Computes the in situ density of sea water for scalar inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]), and pressure [Pa]. It uses the expression from +!! Jackett et al., 2006, J. Atmos. Ocean. Tech., 32, 1709-1728. +subroutine calculate_density_scalar_Jackett(T, S, pressure, rho, rho_ref) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] + + T0(1) = T ; S0(1) = S ; pressure0(1) = pressure + call calculate_density_array_Jackett(T0, S0, pressure0, rho0, 1, 1, rho_ref) + rho = rho0(1) + +end subroutine calculate_density_scalar_Jackett + +!> Computes the Jackett et al. 2006 in situ specific volume of sea water for scalar inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Jackett et al., 2006, J. Atmos. Ocean. Tech., 32, 1709-1728. +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_scalar_Jackett(T, S, pressure, specvol, spv_ref) + real, intent(in) :: T !< potential temperature relative to the surface [degC]. + real, intent(in) :: S !< salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] + + T0(1) = T ; S0(1) = S ; pressure0(1) = pressure + call calculate_spec_vol_array_Jackett(T0, S0, pressure0, spv0, 1, 1, spv_ref) + specvol = spv0(1) +end subroutine calculate_spec_vol_scalar_Jackett + +!> Return the thermal/haline expansion coefficients for scalar inputs and outputs +!! +!! The scalar version of calculate_density_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_derivs_scalar_Jackett(T, S, pressure, drho_dT, drho_dS) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature [kg m-3 degC-1]. + real, intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in [kg m-3 PSU-1]. + + ! Local variables needed to promote the input/output scalars to 1-element arrays + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! The derivative of density with temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! The derivative of density with salinity [kg m-3 PSU-1] + + T0(1) = T ; S0(1) = S ; P0(1) = pressure + call calculate_density_derivs_array_Jackett(T0, S0, P0, drdt0, drds0, 1, 1) + drho_dT = drdt0(1) ; drho_dS = drds0(1) + +end subroutine calculate_density_derivs_scalar_Jackett + +!> Second derivatives of density with respect to temperature, salinity, and pressure for scalar inputs. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_second_derivs_scalar_Jackett(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Potential temperature referenced to 0 dbar + real, intent(in ) :: S !< Salinity [PSU] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T ; S0(1) = S ; P0(1) = P + call calculate_density_second_derivs_array_Jackett(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) ; drho_ds_dt = drdsdt(1) ; drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) ; drho_dt_dp = drdtdp(1) + +end subroutine calculate_density_second_derivs_scalar_Jackett + +!> Return the range of temperatures, salinities and pressures for which the Jackett et al. (2006) +!! equation of state has been fitted to observations. Care should be taken when applying this +!! equation of state outside of its fit range. +subroutine EoS_fit_range_Jackett06(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: S_max !< The maximum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + ! Note that the actual fit range is given for the surface range of temperatures and salinities, + ! but Jackett et al. use a more limited range of properties at higher pressures. + if (present(T_min)) T_min = -4.5 + if (present(T_max)) T_max = 40.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 42.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 8.5e7 + +end subroutine EoS_fit_range_Jackett06 + +!> \namespace mom_eos_Jackett06 +!! +!! \section section_EOS_Jackett06 Jackett et al. 2006 (Hycom-25-term) equation of state +!! +!! Jackett et al. (2006) provide an approximation for the in situ density as a function of +!! potential temperature, salinity, and pressure. This 25 term equation of state is +!! frequently used in Hycom for a potential density, at which point it only has 17 terms +!! and so is commonly called the "17-term equation of state" there. Here the full expressions +!! for the in situ densities are used. +!! +!! The functional form of this equation of state includes terms proportional to salinity to the +!! 3/2 power. This introduces a singularity in the second derivative of density with salinity +!! at a salinity of 0, but this has been addressed here by setting a floor of 1e-8 PSU on the +!! salinity that is used in the denominator of these second derivative expressions. This value +!! was chosen to imply a contribution that is smaller than numerical roundoff in the expression for +!! density, which is the field for which the Jackett et al. equation of state was originally derived. +!! +!! \subsection section_EOS_Jackett06_references References +!! +!! Jackett, D., T. McDougall, R. Feistel, D. Wright and S. Griffies (2006), +!! Algorithms for density, potential temperature, conservative +!! temperature, and the freezing temperature of seawater, JAOT +!! doi.org/10.1175/JTECH1946.1 + +end module MOM_EOS_Jackett06 diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 deleted file mode 100644 index dee2bc48bf..0000000000 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ /dev/null @@ -1,432 +0,0 @@ -!> The equation of state using the expressions of Roquet et al. that are used in NEMO -module MOM_EOS_NEMO - -! This file is part of MOM6. See LICENSE.md for the license. - -!*********************************************************************** -!* The subroutines in this file implement the equation of state for * -!* sea water using the formulae provided by NEMO developer Roquet * -!* in a private communication , Roquet et al, Ocean Modelling (2015) * -!* Roquet, F., Madec, G., McDougall, T. J., and Barker, P. M., 2015. * -!* Accurate polynomial expressions for the density and specific volume* -!* of seawater using the TEOS-10 standard. Ocean Modelling, 90:29-43. * -!* These algorithms are NOT from the standard NEMO package!! * -!*********************************************************************** - -!use gsw_mod_toolbox, only : gsw_sr_from_sp, gsw_ct_from_pt -use gsw_mod_toolbox, only : gsw_rho_first_derivatives - -implicit none ; private - -public calculate_compress_nemo, calculate_density_nemo -public calculate_density_derivs_nemo -public calculate_density_scalar_nemo, calculate_density_array_nemo - -!> Compute the in situ density of sea water [kg m-3], or its anomaly with respect to -!! a reference density, from absolute salinity [g kg-1], conservative temperature [degC], -!! and pressure [Pa], using the expressions derived for use with NEMO -interface calculate_density_nemo - module procedure calculate_density_scalar_nemo, calculate_density_array_nemo -end interface calculate_density_nemo - -!> For a given thermodynamic state, return the derivatives of density with conservative temperature -!! and absolute salinity, the expressions derived for use with NEMO -interface calculate_density_derivs_nemo - module procedure calculate_density_derivs_scalar_nemo, calculate_density_derivs_array_nemo -end interface calculate_density_derivs_nemo - -real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar [Pa dbar-1] -!>@{ Parameters in the NEMO equation of state -real, parameter :: rdeltaS = 32. ! An offset to salinity before taking its square root [g kg-1] -real, parameter :: r1_S0 = 0.875/35.16504 ! The inverse of a plausible range of oceanic salinities [kg g-1] -real, parameter :: r1_T0 = 1./40. ! The inverse of a plausible range of oceanic temperatures [degC-1] -real, parameter :: r1_P0 = 1.e-4 ! The inverse of a plausible range of oceanic pressures [dbar-1] -real, parameter :: R00 = 4.6494977072e+01 ! Contribution to zr0 proportional to zp [kg m-3] -real, parameter :: R01 = -5.2099962525 ! Contribution to zr0 proportional to zp**2 [kg m-3] -real, parameter :: R02 = 2.2601900708e-01 ! Contribution to zr0 proportional to zp**3 [kg m-3] -real, parameter :: R03 = 6.4326772569e-02 ! Contribution to zr0 proportional to zp**4 [kg m-3] -real, parameter :: R04 = 1.5616995503e-02 ! Contribution to zr0 proportional to zp**5 [kg m-3] -real, parameter :: R05 = -1.7243708991e-03 ! Contribution to zr0 proportional to zp**6 [kg m-3] - -! The following terms are contributions to density as a function of the normalized square root of salinity -! with an offset (zs), temperature (zt) and pressure, with a contribution EOSabc * zs**a * zt**b * zp**c -real, parameter :: EOS000 = 8.0189615746e+02 ! A constant density contribution [kg m-3] -real, parameter :: EOS100 = 8.6672408165e+02 ! Coefficient of the EOS proportional to zs [kg m-3] -real, parameter :: EOS200 = -1.7864682637e+03 ! Coefficient of the EOS proportional to zs**2 [kg m-3] -real, parameter :: EOS300 = 2.0375295546e+03 ! Coefficient of the EOS proportional to zs**3 [kg m-3] -real, parameter :: EOS400 = -1.2849161071e+03 ! Coefficient of the EOS proportional to zs**4 [kg m-3] -real, parameter :: EOS500 = 4.3227585684e+02 ! Coefficient of the EOS proportional to zs**5 [kg m-3] -real, parameter :: EOS600 = -6.0579916612e+01 ! Coefficient of the EOS proportional to zs**6 [kg m-3] -real, parameter :: EOS010 = 2.6010145068e+01 ! Coefficient of the EOS proportional to zt [kg m-3] -real, parameter :: EOS110 = -6.5281885265e+01 ! Coefficient of the EOS proportional to zs * zt [kg m-3] -real, parameter :: EOS210 = 8.1770425108e+01 ! Coefficient of the EOS proportional to zs**2 * zt [kg m-3] -real, parameter :: EOS310 = -5.6888046321e+01 ! Coefficient of the EOS proportional to zs**3 * zt [kg m-3] -real, parameter :: EOS410 = 1.7681814114e+01 ! Coefficient of the EOS proportional to zs**2 * zt [kg m-3] -real, parameter :: EOS510 = -1.9193502195 ! Coefficient of the EOS proportional to zs**5 * zt [kg m-3] -real, parameter :: EOS020 = -3.7074170417e+01 ! Coefficient of the EOS proportional to zt**2 [kg m-3] -real, parameter :: EOS120 = 6.1548258127e+01 ! Coefficient of the EOS proportional to zs * zt**2 [kg m-3] -real, parameter :: EOS220 = -6.0362551501e+01 ! Coefficient of the EOS proportional to zs**2 * zt**2 [kg m-3] -real, parameter :: EOS320 = 2.9130021253e+01 ! Coefficient of the EOS proportional to s**3 * zt**2 [kg m-3] -real, parameter :: EOS420 = -5.4723692739 ! Coefficient of the EOS proportional to zs**4 * zt**2 [kg m-3] -real, parameter :: EOS030 = 2.1661789529e+01 ! Coefficient of the EOS proportional to zt**3 [kg m-3] -real, parameter :: EOS130 = -3.3449108469e+01 ! Coefficient of the EOS proportional to zs * zt**3 [kg m-3] -real, parameter :: EOS230 = 1.9717078466e+01 ! Coefficient of the EOS proportional to zs**2 * zt**3 [kg m-3] -real, parameter :: EOS330 = -3.1742946532 ! Coefficient of the EOS proportional to zs**3 * zt**3 [kg m-3] -real, parameter :: EOS040 = -8.3627885467 ! Coefficient of the EOS proportional to zt**4 [kg m-3] -real, parameter :: EOS140 = 1.1311538584e+01 ! Coefficient of the EOS proportional to zs * zt**4 [kg m-3] -real, parameter :: EOS240 = -5.3563304045 ! Coefficient of the EOS proportional to zs**2 * zt**4 [kg m-3] -real, parameter :: EOS050 = 5.4048723791e-01 ! Coefficient of the EOS proportional to zt**5 [kg m-3] -real, parameter :: EOS150 = 4.8169980163e-01 ! Coefficient of the EOS proportional to zs * zt**5 [kg m-3] -real, parameter :: EOS060 = -1.9083568888e-01 ! Coefficient of the EOS proportional to zt**6 [kg m-3] -real, parameter :: EOS001 = 1.9681925209e+01 ! Coefficient of the EOS proportional to zp [kg m-3] -real, parameter :: EOS101 = -4.2549998214e+01 ! Coefficient of the EOS proportional to zs * zp [kg m-3] -real, parameter :: EOS201 = 5.0774768218e+01 ! Coefficient of the EOS proportional to zs**2 * zp [kg m-3] -real, parameter :: EOS301 = -3.0938076334e+01 ! Coefficient of the EOS proportional to zs**3 * zp [kg m-3] -real, parameter :: EOS401 = 6.6051753097 ! Coefficient of the EOS proportional to zs**4 * zp [kg m-3] -real, parameter :: EOS011 = -1.3336301113e+01 ! Coefficient of the EOS proportional to zt * zp [kg m-3] -real, parameter :: EOS111 = -4.4870114575 ! Coefficient of the EOS proportional to zs * zt * zp [kg m-3] -real, parameter :: EOS211 = 5.0042598061 ! Coefficient of the EOS proportional to zs**2 * zt * zp [kg m-3] -real, parameter :: EOS311 = -6.5399043664e-01 ! Coefficient of the EOS proportional to zs**3 * zt * zp [kg m-3] -real, parameter :: EOS021 = 6.7080479603 ! Coefficient of the EOS proportional to zt**2 * zp [kg m-3] -real, parameter :: EOS121 = 3.5063081279 ! Coefficient of the EOS proportional to zs * zt**2 * zp [kg m-3] -real, parameter :: EOS221 = -1.8795372996 ! Coefficient of the EOS proportional to zs**2 * zt**2 * zp [kg m-3] -real, parameter :: EOS031 = -2.4649669534 ! Coefficient of the EOS proportional to zt**3 * zp [kg m-3] -real, parameter :: EOS131 = -5.5077101279e-01 ! Coefficient of the EOS proportional to zs * zt**3 * zp [kg m-3] -real, parameter :: EOS041 = 5.5927935970e-01 ! Coefficient of the EOS proportional to zt**4 * zp [kg m-3] -real, parameter :: EOS002 = 2.0660924175 ! Coefficient of the EOS proportional to zp**2 [kg m-3] -real, parameter :: EOS102 = -4.9527603989 ! Coefficient of the EOS proportional to zs * zp**2 [kg m-3] -real, parameter :: EOS202 = 2.5019633244 ! Coefficient of the EOS proportional to zs**2 * zp**2 [kg m-3] -real, parameter :: EOS012 = 2.0564311499 ! Coefficient of the EOS proportional to zt * zp**2 [kg m-3] -real, parameter :: EOS112 = -2.1311365518e-01 ! Coefficient of the EOS proportional to zs * zt * zp**2 [kg m-3] -real, parameter :: EOS022 = -1.2419983026 ! Coefficient of the EOS proportional to zt**2 * zp**2 [kg m-3] -real, parameter :: EOS003 = -2.3342758797e-02 ! Coefficient of the EOS proportional to zp**3 [kg m-3] -real, parameter :: EOS103 = -1.8507636718e-02 ! Coefficient of the EOS proportional to zs * zp**3 [kg m-3] -real, parameter :: EOS013 = 3.7969820455e-01 ! Coefficient of the EOS proportional to zt * zp**3 [kg m-3] - -real, parameter :: ALP000 = -6.5025362670e-01 ! Constant in the drho_dT fit [kg m-3 degC-1] -real, parameter :: ALP100 = 1.6320471316 ! Coefficient of the drho_dT fit zs term [kg m-3 degC-1] -real, parameter :: ALP200 = -2.0442606277 ! Coefficient of the drho_dT fit zs**2 term [kg m-3 degC-1] -real, parameter :: ALP300 = 1.4222011580 ! Coefficient of the drho_dT fit zs**3 term [kg m-3 degC-1] -real, parameter :: ALP400 = -4.4204535284e-01 ! Coefficient of the drho_dT fit zs**4 term [kg m-3 degC-1] -real, parameter :: ALP500 = 4.7983755487e-02 ! Coefficient of the drho_dT fit zs**5 term [kg m-3 degC-1] -real, parameter :: ALP010 = 1.8537085209 ! Coefficient of the drho_dT fit zt term [kg m-3 degC-1] -real, parameter :: ALP110 = -3.0774129064 ! Coefficient of the drho_dT fit zs * zt term [kg m-3 degC-1] -real, parameter :: ALP210 = 3.0181275751 ! Coefficient of the drho_dT fit zs**2 * zt term [kg m-3 degC-1] -real, parameter :: ALP310 = -1.4565010626 ! Coefficient of the drho_dT fit zs**3 * zt term [kg m-3 degC-1] -real, parameter :: ALP410 = 2.7361846370e-01 ! Coefficient of the drho_dT fit zs**4 * zt term [kg m-3 degC-1] -real, parameter :: ALP020 = -1.6246342147 ! Coefficient of the drho_dT fit zt**2 term [kg m-3 degC-1] -real, parameter :: ALP120 = 2.5086831352 ! Coefficient of the drho_dT fit zs * zt**2 term [kg m-3 degC-1] -real, parameter :: ALP220 = -1.4787808849 ! Coefficient of the drho_dT fit zs**2 * zt**2 term [kg m-3 degC-1] -real, parameter :: ALP320 = 2.3807209899e-01 ! Coefficient of the drho_dT fit zs**3 * zt**2 term [kg m-3 degC-1] -real, parameter :: ALP030 = 8.3627885467e-01 ! Coefficient of the drho_dT fit zt**3 term [kg m-3 degC-1] -real, parameter :: ALP130 = -1.1311538584 ! Coefficient of the drho_dT fit zs * zt**3 term [kg m-3 degC-1] -real, parameter :: ALP230 = 5.3563304045e-01 ! Coefficient of the drho_dT fit zs**2 * zt**3 term [kg m-3 degC-1] -real, parameter :: ALP040 = -6.7560904739e-02 ! Coefficient of the drho_dT fit zt**4 term [kg m-3 degC-1] -real, parameter :: ALP140 = -6.0212475204e-02 ! Coefficient of the drho_dT fit zs* * zt**4 term [kg m-3 degC-1] -real, parameter :: ALP050 = 2.8625353333e-02 ! Coefficient of the drho_dT fit zt**5 term [kg m-3 degC-1] -real, parameter :: ALP001 = 3.3340752782e-01 ! Coefficient of the drho_dT fit zp term [kg m-3 degC-1] -real, parameter :: ALP101 = 1.1217528644e-01 ! Coefficient of the drho_dT fit zs * zp term [kg m-3 degC-1] -real, parameter :: ALP201 = -1.2510649515e-01 ! Coefficient of the drho_dT fit zs**2 * zp term [kg m-3 degC-1] -real, parameter :: ALP301 = 1.6349760916e-02 ! Coefficient of the drho_dT fit zs**3 * zp term [kg m-3 degC-1] -real, parameter :: ALP011 = -3.3540239802e-01 ! Coefficient of the drho_dT fit zt * zp term [kg m-3 degC-1] -real, parameter :: ALP111 = -1.7531540640e-01 ! Coefficient of the drho_dT fit zs * zt * zp term [kg m-3 degC-1] -real, parameter :: ALP211 = 9.3976864981e-02 ! Coefficient of the drho_dT fit zs**2 * zt * zp term [kg m-3 degC-1] -real, parameter :: ALP021 = 1.8487252150e-01 ! Coefficient of the drho_dT fit zt**2 * zp term [kg m-3 degC-1] -real, parameter :: ALP121 = 4.1307825959e-02 ! Coefficient of the drho_dT fit zs * zt**2 * zp term [kg m-3 degC-1] -real, parameter :: ALP031 = -5.5927935970e-02 ! Coefficient of the drho_dT fit zt**3 * zp term [kg m-3 degC-1] -real, parameter :: ALP002 = -5.1410778748e-02 ! Coefficient of the drho_dT fit zp**2 term [kg m-3 degC-1] -real, parameter :: ALP102 = 5.3278413794e-03 ! Coefficient of the drho_dT fit zs * zp**2 term [kg m-3 degC-1] -real, parameter :: ALP012 = 6.2099915132e-02 ! Coefficient of the drho_dT fit zt * zp**2 term [kg m-3 degC-1] -real, parameter :: ALP003 = -9.4924551138e-03 ! Coefficient of the drho_dT fit zp**3 term [kg m-3 degC-1] - -real, parameter :: BET000 = 1.0783203594e+01 ! Constant in the drho_dS fit [kg m-3 ppt-1] -real, parameter :: BET100 = -4.4452095908e+01 ! Coefficient of the drho_dS fit zs term [kg m-3 ppt-1] -real, parameter :: BET200 = 7.6048755820e+01 ! Coefficient of the drho_dS fit zs**2 term [kg m-3 ppt-1] -real, parameter :: BET300 = -6.3944280668e+01 ! Coefficient of the drho_dS fit zs**3 term [kg m-3 ppt-1] -real, parameter :: BET400 = 2.6890441098e+01 ! Coefficient of the drho_dS fit zs**4 term [kg m-3 ppt-1] -real, parameter :: BET500 = -4.5221697773 ! Coefficient of the drho_dS fit zs**5 term [kg m-3 ppt-1] -real, parameter :: BET010 = -8.1219372432e-01 ! Coefficient of the drho_dS fit zt term [kg m-3 ppt-1] -real, parameter :: BET110 = 2.0346663041 ! Coefficient of the drho_dS fit zs * zt term [kg m-3 ppt-1] -real, parameter :: BET210 = -2.1232895170 ! Coefficient of the drho_dS fit zs**2 * zt term [kg m-3 ppt-1] -real, parameter :: BET310 = 8.7994140485e-01 ! Coefficient of the drho_dS fit zs**3 * zt term [kg m-3 ppt-1] -real, parameter :: BET410 = -1.1939638360e-01 ! Coefficient of the drho_dS fit zs**4 * zt term [kg m-3 ppt-1] -real, parameter :: BET020 = 7.6574242289e-01 ! Coefficient of the drho_dS fit zt**2 term [kg m-3 ppt-1] -real, parameter :: BET120 = -1.5019813020 ! Coefficient of the drho_dS fit zs * zt**2 term [kg m-3 ppt-1] -real, parameter :: BET220 = 1.0872489522 ! Coefficient of the drho_dS fit zs**2 * zt**2 term [kg m-3 ppt-1] -real, parameter :: BET320 = -2.7233429080e-01 ! Coefficient of the drho_dS fit zs**3 * zt**2 term [kg m-3 ppt-1] -real, parameter :: BET030 = -4.1615152308e-01 ! Coefficient of the drho_dS fit zt**3 term [kg m-3 ppt-1] -real, parameter :: BET130 = 4.9061350869e-01 ! Coefficient of the drho_dS fit zs * zt**3 term [kg m-3 ppt-1] -real, parameter :: BET230 = -1.1847737788e-01 ! Coefficient of the drho_dS fit zs**2 * zt**3 term [kg m-3 ppt-1] -real, parameter :: BET040 = 1.4073062708e-01 ! Coefficient of the drho_dS fit zt**4 term [kg m-3 ppt-1] -real, parameter :: BET140 = -1.3327978879e-01 ! Coefficient of the drho_dS fit zs * zt**4 term [kg m-3 ppt-1] -real, parameter :: BET050 = 5.9929880134e-03 ! Coefficient of the drho_dS fit zt**5 term [kg m-3 ppt-1] -real, parameter :: BET001 = -5.2937873009e-01 ! Coefficient of the drho_dS fit zp term [kg m-3 ppt-1] -real, parameter :: BET101 = 1.2634116779 ! Coefficient of the drho_dS fit zs * zp term [kg m-3 ppt-1] -real, parameter :: BET201 = -1.1547328025 ! Coefficient of the drho_dS fit zs**2 * zp term [kg m-3 ppt-1] -real, parameter :: BET301 = 3.2870876279e-01 ! Coefficient of the drho_dS fit zs**3 * zp term [kg m-3 ppt-1] -real, parameter :: BET011 = -5.5824407214e-02 ! Coefficient of the drho_dS fit zt * zp term [kg m-3 ppt-1] -real, parameter :: BET111 = 1.2451933313e-01 ! Coefficient of the drho_dS fit zs * zt * zp term [kg m-3 ppt-1] -real, parameter :: BET211 = -2.4409539932e-02 ! Coefficient of the drho_dS fit zs**2 * zt * zp term [kg m-3 ppt-1] -real, parameter :: BET021 = 4.3623149752e-02 ! Coefficient of the drho_dS fit zt**2 * zp term [kg m-3 ppt-1] -real, parameter :: BET121 = -4.6767901790e-02 ! Coefficient of the drho_dS fit zs * zt**2 * zp term [kg m-3 ppt-1] -real, parameter :: BET031 = -6.8523260060e-03 ! Coefficient of the drho_dS fit zt**3 * zp term [kg m-3 ppt-1] -real, parameter :: BET002 = -6.1618945251e-02 ! Coefficient of the drho_dS fit zp**2 term [kg m-3 ppt-1] -real, parameter :: BET102 = 6.2255521644e-02 ! Coefficient of the drho_dS fit zs * zp**2 term [kg m-3 ppt-1] -real, parameter :: BET012 = -2.6514181169e-03 ! Coefficient of the drho_dS fit zt * zp**2 term [kg m-3 ppt-1] -real, parameter :: BET003 = -2.3025968587e-04 ! Coefficient of the drho_dS fit zp**3 term [kg m-3 ppt-1] -!>@} - -contains - -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure [Pa]. It uses the expressions derived for use -!! with NEMO. -subroutine calculate_density_scalar_nemo(T, S, pressure, rho, rho_ref) - real, intent(in) :: T !< Conservative temperature [degC]. - real, intent(in) :: S !< Absolute salinity [g kg-1]. - real, intent(in) :: pressure !< pressure [Pa]. - real, intent(out) :: rho !< In situ density [kg m-3]. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - - real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] - real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] - real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] - real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] - - T0(1) = T - S0(1) = S - pressure0(1) = pressure - - call calculate_density_array_nemo(T0, S0, pressure0, rho0, 1, 1, rho_ref) - rho = rho0(1) - -end subroutine calculate_density_scalar_nemo - -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure [Pa]. It uses the expressions derived for use -!! with NEMO. -subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_ref) - real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. - real, dimension(:), intent(in) :: S !< Absolute salinity [g kg-1]. - real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. - integer, intent(in) :: start !< the starting point in the arrays. - integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - - ! Local variables - real :: zp ! Pressure, first in [dbar], then normalized by an assumed pressure range [nondim] - real :: zt ! Conservative temperature, first in [degC], then normalized by an assumed temperature range [nondim] - real :: zs ! Absolute salinity, first in [g kg-1], then the square root of salinity with an offset normalized - ! by an assumed salnity range [nondim] - real :: zr0 ! A pressure-dependent but temperature and salinity independent contribution to - ! density at the reference temperature and salinity [kg m-3] - real :: zn ! Density without a pressure-dependent contribution [kg m-3] - real :: zn0 ! A contribution to density from temperature and salinity anomalies at the surface pressure [kg m-3] - real :: zn1 ! A temperature and salinity dependent density contribution proportional to pressure [kg m-3] - real :: zn2 ! A temperature and salinity dependent density contribution proportional to pressure^2 [kg m-3] - real :: zn3 ! A temperature and salinity dependent density contribution proportional to pressure^3 [kg m-3] - real :: zs0 ! Salinity dependent density at the surface pressure and temperature [kg m-3] - integer :: j - - do j=start,start+npts-1 - ! Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] - zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] - - !The following algorithm was provided by Roquet in a private communication. - !It is not necessarily the algorithm used in NEMO ocean! - zp = zp * r1_P0 ! pressure normalized by a plausible range of pressure in the ocean [nondim] - zt = zt * r1_T0 ! temperature normalized by a plausible oceanic range [nondim] - zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] - - zn3 = EOS013*zt & - & + EOS103*zs+EOS003 - - zn2 = (EOS022*zt & - & + EOS112*zs+EOS012)*zt & - & + (EOS202*zs+EOS102)*zs+EOS002 - - zn1 = (((EOS041*zt & - & + EOS131*zs+EOS031)*zt & - & + (EOS221*zs+EOS121)*zs+EOS021)*zt & - & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & - & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 - - zn0 = (((((EOS060*zt & - & + EOS150*zs+EOS050)*zt & - & + (EOS240*zs+EOS140)*zs+EOS040)*zt & - & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & - & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & - & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt - - zs0 = (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs + EOS000 - - zr0 = (((((R05 * zp+R04) * zp+R03 ) * zp+R02 ) * zp+R01) * zp+R00) * zp - - if (present(rho_ref)) then - zn = ( ( zn3 * zp + zn2 ) * zp + zn1 ) * zp + (zn0 + (zs0 - rho_ref)) - rho(j) = ( zn + zr0 ) ! density - else - zn = ( ( zn3 * zp + zn2 ) * zp + zn1 ) * zp + (zn0 + zs0) - rho(j) = ( zn + zr0 ) ! density - endif - - enddo -end subroutine calculate_density_array_nemo - -!> For a given thermodynamic state, calculate the derivatives of density with conservative -!! temperature and absolute salinity, using the expressions derived for use with NEMO. -subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. - real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. - real, intent(in), dimension(:) :: pressure !< pressure [Pa]. - real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1]. - real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1]. - integer, intent(in) :: start !< The starting point in the arrays. - integer, intent(in) :: npts !< The number of values to calculate. - - ! Local variables - real :: zp ! Pressure, first in [dbar], then normalized by an assumed pressure range [nondim] - real :: zt ! Conservative temperature, first in [degC], then normalized by an assumed temperature range [nondim] - real :: zs ! Absolute salinity, first in [g kg-1], then the square root of salinity with an offset normalized - ! by an assumed salnity range [nondim] - real :: zn ! Partial derivative of density with temperature [kg m-3 degC-1] or salinity [kg m-3 ppt-1] - ! without a pressure-dependent contribution - real :: zn0 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or - ! salinity [kg m-3 ppt-1] from temperature anomalies at the surface pressure - real :: zn1 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or - ! salinity [kg m-3 ppt-1] proportional to pressure - real :: zn2 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or - ! salinity [kg m-3 ppt-1] proportional to pressure^2 - real :: zn3 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or - ! salinity [kg m-3 ppt-1] proportional to pressure^3 - integer :: j - - do j=start,start+npts-1 - ! Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] - zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] - - !The following algorithm was provided by Roquet in a private communication. - !It is not necessarily the algorithm used in NEMO ocean! - zp = zp * r1_P0 ! pressure normalized by a plausible range of pressure in the ocean [nondim] - zt = zt * r1_T0 ! temperature normalized by a plausible oceanic range [nondim] - zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] - ! - ! alpha - zn3 = ALP003 - ! - zn2 = ALP012*zt + ALP102*zs+ALP002 - ! - zn1 = ((ALP031*zt & - & + ALP121*zs+ALP021)*zt & - & + (ALP211*zs+ALP111)*zs+ALP011)*zt & - & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 - ! - zn0 = ((((ALP050*zt & - & + ALP140*zs+ALP040)*zt & - & + (ALP230*zs+ALP130)*zs+ALP030)*zt & - & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & - & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & - & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 - ! - zn = ( ( zn3 * zp + zn2 ) * zp + zn1 ) * zp + zn0 - ! - drho_dT(j) = -zn - ! - ! beta - ! - zn3 = BET003 - ! - zn2 = BET012*zt + BET102*zs+BET002 - ! - zn1 = ((BET031*zt & - & + BET121*zs+BET021)*zt & - & + (BET211*zs+BET111)*zs+BET011)*zt & - & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 - ! - zn0 = ((((BET050*zt & - & + BET140*zs+BET040)*zt & - & + (BET230*zs+BET130)*zs+BET030)*zt & - & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & - & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & - & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 - ! - zn = ( ( zn3 * zp + zn2 ) * zp + zn1 ) * zp + zn0 - - ! The division by zs here is because zs = sqrt(S + S0), so drho_dS = dzs_dS * drho_dzs = (0.5 / zs) * drho_dzs - drho_dS(j) = zn / zs - enddo - -end subroutine calculate_density_derivs_array_nemo - -!> Wrapper to calculate_density_derivs_array for scalar inputs -subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds) - real, intent(in) :: T !< Potential temperature relative to the surface [degC]. - real, intent(in) :: S !< Salinity [g kg-1]. - real, intent(in) :: pressure !< Pressure [Pa]. - real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1]. - real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1]. - ! Local variables - real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] - real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] - real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] - real, dimension(1) :: drdt0 ! A 1-d array with a copy of the derivative of density - ! with potential temperature [kg m-3 degC-1] - real, dimension(1) :: drds0 ! A 1-d array with a copy of the derivative of density - ! with salinity [kg m-3 ppt-1] - - T0(1) = T - S0(1) = S - pressure0(1) = pressure - - call calculate_density_derivs_array_nemo(T0, S0, pressure0, drdt0, drds0, 1, 1) - drho_dt = drdt0(1) - drho_ds = drds0(1) -end subroutine calculate_density_derivs_scalar_nemo - -!> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility -!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), -!! conservative temperature (T [degC]), and pressure [Pa], using the expressions -!! derived for use with NEMO. -subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. - real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. - real, intent(in), dimension(:) :: pressure !< pressure [Pa]. - real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. - real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure - !! (also the inverse of the square of sound speed) - !! [s2 m-2]. - integer, intent(in) :: start !< The starting point in the arrays. - integer, intent(in) :: npts !< The number of values to calculate. - - ! Local variables - real :: zs ! Absolute salinity [g kg-1] - real :: zt ! Conservative temperature [degC] - real :: zp ! Pressure converted to decibars [dbar] - integer :: j - - call calculate_density_array_nemo(T, S, pressure, rho, start, npts) - ! - !NOTE: The following calculates the TEOS10 approximation to compressibility - ! since the corresponding NEMO approximation is not available yet. - ! - do j=start,start+npts-1 - ! Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] - zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] - call gsw_rho_first_derivatives(zs,zt,zp, drho_dp=drho_dp(j)) - enddo -end subroutine calculate_compress_nemo - -end module MOM_EOS_NEMO diff --git a/src/equation_of_state/MOM_EOS_Roquet_SpV.F90 b/src/equation_of_state/MOM_EOS_Roquet_SpV.F90 new file mode 100644 index 0000000000..b6133442db --- /dev/null +++ b/src/equation_of_state/MOM_EOS_Roquet_SpV.F90 @@ -0,0 +1,813 @@ +!> The equation of state for specific volume (SpV) using the expressions of Roquet et al. 2015 +module MOM_EOS_Roquet_Spv + +! This file is part of MOM6. See LICENSE.md for the license. + +!use gsw_mod_toolbox, only : gsw_sr_from_sp, gsw_ct_from_pt + +implicit none ; private + +public calculate_compress_Roquet_SpV, calculate_density_Roquet_SpV, calculate_spec_vol_Roquet_SpV +public calculate_density_derivs_Roquet_SpV, calculate_specvol_derivs_Roquet_SpV +public calculate_density_scalar_Roquet_SpV, calculate_density_array_Roquet_SpV +public calculate_density_second_derivs_Roquet_SpV, EoS_fit_range_Roquet_SpV + +!> Compute the in situ density of sea water [kg m-3], or its anomaly with respect to +!! a reference density, from absolute salinity [g kg-1], conservative temperature [degC], +!! and pressure [Pa], using the specific volume polynomial fit from Roquet et al. (2015) +interface calculate_density_Roquet_SpV + module procedure calculate_density_scalar_Roquet_SpV, calculate_density_array_Roquet_SpV +end interface calculate_density_Roquet_SpV + +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect +!! to a reference specific volume, from absolute salinity ([g kg-1]), conservative +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the specific volume +!! polynomial fit from Roquet et al. (2015) +interface calculate_spec_vol_Roquet_SpV + module procedure calculate_spec_vol_scalar_Roquet_SpV, calculate_spec_vol_array_Roquet_SpV +end interface calculate_spec_vol_Roquet_SpV + +!> For a given thermodynamic state, return the derivatives of density with conservative temperature +!! and absolute salinity, using the specific volume polynomial fit from Roquet et al. (2015) +interface calculate_density_derivs_Roquet_SpV + module procedure calculate_density_derivs_scalar_Roquet_SpV, calculate_density_derivs_array_Roquet_SpV +end interface calculate_density_derivs_Roquet_SpV + +!> Compute the second derivatives of density with various combinations of temperature, salinity +!! and pressure using the specific volume polynomial fit from Roquet et al. (2015) +interface calculate_density_second_derivs_Roquet_SpV + module procedure calculate_density_second_derivs_scalar_Roquet_SpV + module procedure calculate_density_second_derivs_array_Roquet_SpV +end interface calculate_density_second_derivs_Roquet_SpV + +real, parameter :: Pa2kb = 1.e-8 !< Conversion factor between Pa and kbar [kbar Pa-1] +!>@{ Parameters in the Roquet specific volume polynomial equation of state +real, parameter :: rdeltaS = 24. ! An offset to salinity before taking its square root [g kg-1] +real, parameter :: r1_S0 = 0.875/35.16504 ! The inverse of a plausible range of oceanic salinities [kg g-1] +real, parameter :: I_Ts = 0.025 ! The inverse of a plausible range of oceanic temperatures [degC-1] +! The following are the coefficients of the fit to the reference density profile (rho00p) as a function of +! pressure (P), with a contribution R0c * P**(c+1). The nomenclature follows Roquet. +real, parameter :: V00 = -4.4015007269e-05*Pa2kb ! SpV00p P coef. [m3 kg-1 Pa-1] +real, parameter :: V01 = 6.9232335784e-06*Pa2kb**2 ! SpV00p P**2 coef. [m3 kg-1 Pa-2] +real, parameter :: V02 = -7.5004675975e-07*Pa2kb**3 ! SpV00p P**3 coef. [m3 kg-1 Pa-3] +real, parameter :: V03 = 1.7009109288e-08*Pa2kb**4 ! SpV00p P**4 coef. [m3 kg-1 Pa-4] +real, parameter :: V04 = -1.6884162004e-08*Pa2kb**5 ! SpV00p P**5 coef. [m3 kg-1 Pa-5] +real, parameter :: V05 = 1.9613503930e-09*Pa2kb**6 ! SpV00p P**6 coef. [m3 kg-1 Pa-6] + +! The following terms are contributions to specific volume (SpV) as a function of the square root of +! normalized absolute salinity with an offset (zs), temperature (T) and pressure (P), with a contribution +! SPVabc * zs**a * T**b * P**c. The numbers here are copied directly from Roquet et al. (2015), but +! the expressions here do not use the same nondimensionalization for pressure or temperature as they do. +real, parameter :: SPV000 = 1.0772899069e-03 ! Constant SpV contribution [m3 kg-1] +real, parameter :: SPV100 = -3.1263658781e-04 ! SpV zs coef. [m3 kg-1] +real, parameter :: SPV200 = 6.7615860683e-04 ! SpV zs**2 coef. [m3 kg-1] +real, parameter :: SPV300 = -8.6127884515e-04 ! SpV zs**3 coef. [m3 kg-1] +real, parameter :: SPV400 = 5.9010812596e-04 ! SpV zs**4 coef. [m3 kg-1] +real, parameter :: SPV500 = -2.1503943538e-04 ! SpV zs**5 coef. [m3 kg-1] +real, parameter :: SPV600 = 3.2678954455e-05 ! SpV zs**6 coef. [m3 kg-1] +real, parameter :: SPV010 = -1.4949652640e-05*I_Ts ! SpV T coef. [m3 kg-1 degC-1] +real, parameter :: SPV110 = 3.1866349188e-05*I_Ts ! SpV zs * T coef. [m3 kg-1 degC-1] +real, parameter :: SPV210 = -3.8070687610e-05*I_Ts ! SpV zs**2 * T coef. [m3 kg-1 degC-1] +real, parameter :: SPV310 = 2.9818473563e-05*I_Ts ! SpV zs**3 * T coef. [m3 kg-1 degC-1] +real, parameter :: SPV410 = -1.0011321965e-05*I_Ts ! SpV zs**4 * T coef. [m3 kg-1 degC-1] +real, parameter :: SPV510 = 1.0751931163e-06*I_Ts ! SpV zs**5 * T coef. [m3 kg-1 degC-1] +real, parameter :: SPV020 = 2.7546851539e-05*I_Ts**2 ! SpV T**2 coef. [m3 kg-1 degC-2] +real, parameter :: SPV120 = -3.6597334199e-05*I_Ts**2 ! SpV zs * T**2 coef. [m3 kg-1 degC-2] +real, parameter :: SPV220 = 3.4489154625e-05*I_Ts**2 ! SpV zs**2 * T**2 coef. [m3 kg-1 degC-2] +real, parameter :: SPV320 = -1.7663254122e-05*I_Ts**2 ! SpV zs**3 * T**2 coef. [m3 kg-1 degC-2] +real, parameter :: SPV420 = 3.5965131935e-06*I_Ts**2 ! SpV zs**4 * T**2 coef. [m3 kg-1 degC-2] +real, parameter :: SPV030 = -1.6506828994e-05*I_Ts**3 ! SpV T**3 coef. [m3 kg-1 degC-3] +real, parameter :: SPV130 = 2.4412359055e-05*I_Ts**3 ! SpV zs * T**3 coef. [m3 kg-1 degC-3] +real, parameter :: SPV230 = -1.4606740723e-05*I_Ts**3 ! SpV zs**2 * T**3 coef. [m3 kg-1 degC-3] +real, parameter :: SPV330 = 2.3293406656e-06*I_Ts**3 ! SpV zs**3 * T**3 coef. [m3 kg-1 degC-3] +real, parameter :: SPV040 = 6.7896174634e-06*I_Ts**4 ! SpV T**4 coef. [m3 kg-1 degC-4] +real, parameter :: SPV140 = -8.7951832993e-06*I_Ts**4 ! SpV zs * T**4 coef. [m3 kg-1 degC-4] +real, parameter :: SPV240 = 4.4249040774e-06*I_Ts**4 ! SpV zs**2 * T**4 coef. [m3 kg-1 degC-4] +real, parameter :: SPV050 = -7.2535743349e-07*I_Ts**5 ! SpV T**5 coef. [m3 kg-1 degC-5] +real, parameter :: SPV150 = -3.4680559205e-07*I_Ts**5 ! SpV zs * T**5 coef. [m3 kg-1 degC-5] +real, parameter :: SPV060 = 1.9041365570e-07*I_Ts**6 ! SpV T**6 coef. [m3 kg-1 degC-6] +real, parameter :: SPV001 = -1.6889436589e-05*Pa2kb ! SpV P coef. [m3 kg-1 Pa-1] +real, parameter :: SPV101 = 2.1106556158e-05*Pa2kb ! SpV zs * P coef. [m3 kg-1 Pa-1] +real, parameter :: SPV201 = -2.1322804368e-05*Pa2kb ! SpV zs**2 * P coef. [m3 kg-1 Pa-1] +real, parameter :: SPV301 = 1.7347655458e-05*Pa2kb ! SpV zs**3 * P coef. [m3 kg-1 Pa-1] +real, parameter :: SPV401 = -4.3209400767e-06*Pa2kb ! SpV zs**4 * P coef. [m3 kg-1 Pa-1] +real, parameter :: SPV011 = 1.5355844621e-05*(I_Ts*Pa2kb) ! SpV T * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: SPV111 = 2.0914122241e-06*(I_Ts*Pa2kb) ! SpV zs * T * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: SPV211 = -5.7751479725e-06*(I_Ts*Pa2kb) ! SpV zs**2 * T * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: SPV311 = 1.0767234341e-06*(I_Ts*Pa2kb) ! SpV zs**3 * T * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: SPV021 = -9.6659393016e-06*(I_Ts**2*Pa2kb) ! SpV T**2 * P coef. [m3 kg-1 degC-2 Pa-1] +real, parameter :: SPV121 = -7.0686982208e-07*(I_Ts**2*Pa2kb) ! SpV zs * T**2 * P coef. [m3 kg-1 degC-2 Pa-1] +real, parameter :: SPV221 = 1.4488066593e-06*(I_Ts**2*Pa2kb) ! SpV zs**2 * T**2 * P coef. [m3 kg-1 degC-2 Pa-1] +real, parameter :: SPV031 = 3.1134283336e-06*(I_Ts**3*Pa2kb) ! SpV T**3 * P coef. [m3 kg-1 degC-3 Pa-1] +real, parameter :: SPV131 = 7.9562529879e-08*(I_Ts**3*Pa2kb) ! SpV zs * T**3 * P coef. [m3 kg-1 degC-3 Pa-1] +real, parameter :: SPV041 = -5.6590253863e-07*(I_Ts**4*Pa2kb) ! SpV T**4 * P coef. [m3 kg-1 degC-4 Pa-1] +real, parameter :: SPV002 = 1.0500241168e-06*Pa2kb**2 ! SpV P**2 coef. [m3 kg-1 Pa-2] +real, parameter :: SPV102 = 1.9600661704e-06*Pa2kb**2 ! SpV zs * P**2 coef. [m3 kg-1 Pa-2] +real, parameter :: SPV202 = -2.1666693382e-06*Pa2kb**2 ! SpV zs**2 * P**2 coef. [m3 kg-1 Pa-2] +real, parameter :: SPV012 = -3.8541359685e-06*(I_Ts*Pa2kb**2) ! SpV T * P**2 coef. [m3 kg-1 degC-1 Pa-2] +real, parameter :: SPV112 = 1.0157632247e-06*(I_Ts*Pa2kb**2) ! SpV zs * T * P**2 coef. [m3 kg-1 degC-1 Pa-2] +real, parameter :: SPV022 = 1.7178343158e-06*(I_Ts**2*Pa2kb**2) ! SpV T**2 * P**2 coef. [m3 kg-1 degC-2 Pa-2] +real, parameter :: SPV003 = -4.1503454190e-07*Pa2kb**3 ! SpV P**3 coef. [m3 kg-1 Pa-3] +real, parameter :: SPV103 = 3.5627020989e-07*Pa2kb**3 ! SpV zs * P**3 coef. [m3 kg-1 Pa-3] +real, parameter :: SPV013 = -1.1293871415e-07*(I_Ts*Pa2kb**3) ! SpV T * P**3 coef. [m3 kg-1 degC-1 Pa-3] + +real, parameter :: ALP000 = SPV010 ! Constant in the dSpV_dT fit [m3 kg-1 degC-1] +real, parameter :: ALP100 = SPV110 ! dSpV_dT fit zs coef. [m3 kg-1 degC-1] +real, parameter :: ALP200 = SPV210 ! dSpV_dT fit zs**2 coef. [m3 kg-1 degC-1] +real, parameter :: ALP300 = SPV310 ! dSpV_dT fit zs**3 coef. [m3 kg-1 degC-1] +real, parameter :: ALP400 = SPV410 ! dSpV_dT fit zs**4 coef. [m3 kg-1 degC-1] +real, parameter :: ALP500 = SPV510 ! dSpV_dT fit zs**5 coef. [m3 kg-1 degC-1] +real, parameter :: ALP010 = 2.*SPV020 ! dSpV_dT fit T coef. [m3 kg-1 degC-2] +real, parameter :: ALP110 = 2.*SPV120 ! dSpV_dT fit zs * T coef. [m3 kg-1 degC-2] +real, parameter :: ALP210 = 2.*SPV220 ! dSpV_dT fit zs**2 * T coef. [m3 kg-1 degC-2] +real, parameter :: ALP310 = 2.*SPV320 ! dSpV_dT fit zs**3 * T coef. [m3 kg-1 degC-2] +real, parameter :: ALP410 = 2.*SPV420 ! dSpV_dT fit zs**4 * T coef. [m3 kg-1 degC-2] +real, parameter :: ALP020 = 3.*SPV030 ! dSpV_dT fit T**2 coef. [m3 kg-1 degC-3] +real, parameter :: ALP120 = 3.*SPV130 ! dSpV_dT fit zs * T**2 coef. [m3 kg-1 degC-3] +real, parameter :: ALP220 = 3.*SPV230 ! dSpV_dT fit zs**2 * T**2 coef. [m3 kg-1 degC-3] +real, parameter :: ALP320 = 3.*SPV330 ! dSpV_dT fit zs**3 * T**2 coef. [m3 kg-1 degC-3] +real, parameter :: ALP030 = 4.*SPV040 ! dSpV_dT fit T**3 coef. [m3 kg-1 degC-4] +real, parameter :: ALP130 = 4.*SPV140 ! dSpV_dT fit zs * T**3 coef. [m3 kg-1 degC-4] +real, parameter :: ALP230 = 4.*SPV240 ! dSpV_dT fit zs**2 * T**3 coef. [m3 kg-1 degC-4] +real, parameter :: ALP040 = 5.*SPV050 ! dSpV_dT fit T**4 coef. [m3 kg-1 degC-5] +real, parameter :: ALP140 = 5.*SPV150 ! dSpV_dT fit zs* * T**4 coef. [m3 kg-1 degC-5] +real, parameter :: ALP050 = 6.*SPV060 ! dSpV_dT fit T**5 coef. [m3 kg-1 degC-6] +real, parameter :: ALP001 = SPV011 ! dSpV_dT fit P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: ALP101 = SPV111 ! dSpV_dT fit zs * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: ALP201 = SPV211 ! dSpV_dT fit zs**2 * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: ALP301 = SPV311 ! dSpV_dT fit zs**3 * P coef. [m3 kg-1 degC-1 Pa-1] +real, parameter :: ALP011 = 2.*SPV021 ! dSpV_dT fit T * P coef. [m3 kg-1 degC-2 Pa-1] +real, parameter :: ALP111 = 2.*SPV121 ! dSpV_dT fit zs * T * P coef. [m3 kg-1 degC-2 Pa-1] +real, parameter :: ALP211 = 2.*SPV221 ! dSpV_dT fit zs**2 * T * P coef. [m3 kg-1 degC-2 Pa-1] +real, parameter :: ALP021 = 3.*SPV031 ! dSpV_dT fit T**2 * P coef. [m3 kg-1 degC-3 Pa-1] +real, parameter :: ALP121 = 3.*SPV131 ! dSpV_dT fit zs * T**2 * P coef. [m3 kg-1 degC-3 Pa-1] +real, parameter :: ALP031 = 4.*SPV041 ! dSpV_dT fit T**3 * P coef. [m3 kg-1 degC-4 Pa-1] +real, parameter :: ALP002 = SPV012 ! dSpV_dT fit P**2 coef. [m3 kg-1 degC-1 Pa-2] +real, parameter :: ALP102 = SPV112 ! dSpV_dT fit zs * P**2 coef. [m3 kg-1 degC-1 Pa-2] +real, parameter :: ALP012 = 2.*SPV022 ! dSpV_dT fit T * P**2 coef. [m3 kg-1 degC-2 Pa-2] +real, parameter :: ALP003 = SPV013 ! dSpV_dT fit P**3 coef. [m3 kg-1 degC-1 Pa-3] + +real, parameter :: BET000 = 0.5*SPV100*r1_S0 ! Constant in the dSpV_dS fit [m3 kg-1 ppt-1] +real, parameter :: BET100 = SPV200*r1_S0 ! dSpV_dS fit zs coef. [m3 kg-1 ppt-1] +real, parameter :: BET200 = 1.5*SPV300*r1_S0 ! dSpV_dS fit zs**2 coef. [m3 kg-1 ppt-1] +real, parameter :: BET300 = 2.0*SPV400*r1_S0 ! dSpV_dS fit zs**3 coef. [m3 kg-1 ppt-1] +real, parameter :: BET400 = 2.5*SPV500*r1_S0 ! dSpV_dS fit zs**4 coef. [m3 kg-1 ppt-1] +real, parameter :: BET500 = 3.0*SPV600*r1_S0 ! dSpV_dS fit zs**5 coef. [m3 kg-1 ppt-1] +real, parameter :: BET010 = 0.5*SPV110*r1_S0 ! dSpV_dS fit T coef. [m3 kg-1 ppt-1 degC-1] +real, parameter :: BET110 = SPV210*r1_S0 ! dSpV_dS fit zs * T coef. [m3 kg-1 ppt-1 degC-1] +real, parameter :: BET210 = 1.5*SPV310*r1_S0 ! dSpV_dS fit zs**2 * T coef. [m3 kg-1 ppt-1 degC-1] +real, parameter :: BET310 = 2.0*SPV410*r1_S0 ! dSpV_dS fit zs**3 * T coef. [m3 kg-1 ppt-1 degC-1] +real, parameter :: BET410 = 2.5*SPV510*r1_S0 ! dSpV_dS fit zs**4 * T coef. [m3 kg-1 ppt-1 degC-1] +real, parameter :: BET020 = 0.5*SPV120*r1_S0 ! dSpV_dS fit T**2 coef. [m3 kg-1 ppt-1 degC-2] +real, parameter :: BET120 = SPV220*r1_S0 ! dSpV_dS fit zs * T**2 coef. [m3 kg-1 ppt-1 degC-2] +real, parameter :: BET220 = 1.5*SPV320*r1_S0 ! dSpV_dS fit zs**2 * T**2 coef. [m3 kg-1 ppt-1 degC-2] +real, parameter :: BET320 = 2.0*SPV420*r1_S0 ! dSpV_dS fit zs**3 * T**2 coef. [m3 kg-1 ppt-1 degC-2] +real, parameter :: BET030 = 0.5*SPV130*r1_S0 ! dSpV_dS fit T**3 coef. [m3 kg-1 ppt-1 degC-3] +real, parameter :: BET130 = SPV230*r1_S0 ! dSpV_dS fit zs * T**3 coef. [m3 kg-1 ppt-1 degC-3] +real, parameter :: BET230 = 1.5*SPV330*r1_S0 ! dSpV_dS fit zs**2 * T**3 coef. [m3 kg-1 ppt-1 degC-3] +real, parameter :: BET040 = 0.5*SPV140*r1_S0 ! dSpV_dS fit T**4 coef. [m3 kg-1 ppt-1 degC-4] +real, parameter :: BET140 = SPV240*r1_S0 ! dSpV_dS fit zs * T**4 coef. [m3 kg-1 ppt-1 degC-4] +real, parameter :: BET050 = 0.5*SPV150*r1_S0 ! dSpV_dS fit T**5 coef. [m3 kg-1 ppt-1 degC-5] +real, parameter :: BET001 = 0.5*SPV101*r1_S0 ! dSpV_dS fit P coef. [m3 kg-1 ppt-1 Pa-1] +real, parameter :: BET101 = SPV201*r1_S0 ! dSpV_dS fit zs * P coef. [m3 kg-1 ppt-1 Pa-1] +real, parameter :: BET201 = 1.5*SPV301*r1_S0 ! dSpV_dS fit zs**2 * P coef. [m3 kg-1 ppt-1 Pa-1] +real, parameter :: BET301 = 2.0*SPV401*r1_S0 ! dSpV_dS fit zs**3 * P coef. [m3 kg-1 ppt-1 Pa-1] +real, parameter :: BET011 = 0.5*SPV111*r1_S0 ! dSpV_dS fit T * P coef. [m3 kg-1 ppt-1 degC-1 Pa-1] +real, parameter :: BET111 = SPV211*r1_S0 ! dSpV_dS fit zs * T * P coef. [m3 kg-1 ppt-1 degC-1 Pa-1] +real, parameter :: BET211 = 1.5*SPV311*r1_S0 ! dSpV_dS fit zs**2 * T * P coef. [m3 kg-1 ppt-1 degC-1 Pa-1] +real, parameter :: BET021 = 0.5*SPV121*r1_S0 ! dSpV_dS fit T**2 * P coef. [m3 kg-1 ppt-1 degC-2 Pa-1] +real, parameter :: BET121 = SPV221*r1_S0 ! dSpV_dS fit zs * T**2 * P coef. [m3 kg-1 ppt-1 degC-2 Pa-1] +real, parameter :: BET031 = 0.5*SPV131*r1_S0 ! dSpV_dS fit T**3 * P coef. [m3 kg-1 ppt-1 degC-3 Pa-1] +real, parameter :: BET002 = 0.5*SPV102*r1_S0 ! dSpV_dS fit P**2 coef. [m3 kg-1 ppt-1 Pa-2] +real, parameter :: BET102 = SPV202*r1_S0 ! dSpV_dS fit zs * P**2 coef. [m3 kg-1 ppt-1 Pa-2] +real, parameter :: BET012 = 0.5*SPV112*r1_S0 ! dSpV_dS fit T * P**2 coef. [m3 kg-1 ppt-1 degC-1 Pa-2] +real, parameter :: BET003 = 0.5*SPV103*r1_S0 ! dSpV_dS fit P**3 coef. [m3 kg-1 ppt-1 Pa-3] +!>@} + +contains + +!> Computes the Roquet et al. in situ specific volume of sea water for scalar inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from absolute salinity (S [g kg-1]), +!! conservative temperature (T [degC]) and pressure [Pa]. It uses the specific volume polynomial +!! fit from Roquet et al. (2015). +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_scalar_Roquet_SpV(T, S, pressure, specvol, spv_ref) + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: specvol !< In situ specific volume [m3 kg-1] + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolutes salinity [g kg-1] + real, dimension(1) :: pres0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] + + T0(1) = T ; S0(1) = S ; pres0(1) = pressure + + call calculate_spec_vol_array_Roquet_SpV(T0, S0, pres0, spv0, 1, 1, spv_ref) + specvol = spv0(1) + +end subroutine calculate_spec_vol_scalar_Roquet_SpV + +!> Computes the Roquet et al. in situ specific volume of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from absolute salinity (S [g kg-1]), +!! conservative temperature (T [degC]) and pressure [Pa]. It uses the specific volume polynomial +!! fit from Roquet et al. (2015). +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_array_Roquet_SpV(T, S, pressure, specvol, start, npts, spv_ref) + real, dimension(:), intent(in) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in) :: S !< Absolute salinity [g kg-1] + real, dimension(:), intent(in) :: pressure !< pressure [Pa] + real, dimension(:), intent(inout) :: specvol !< in situ specific volume [m3 kg-1] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< the number of values to calculate + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: SV_00p ! A pressure-dependent but temperature and salinity independent contribution to + ! specific volume at the reference temperature and salinity [m3 kg-1] + real :: SV_TS ! Specific volume without a pressure-dependent contribution [m3 kg-1] + real :: SV_TS0 ! A contribution to specific volume from temperature and salinity anomalies at + ! the surface pressure [m3 kg-1] + real :: SV_TS1 ! A temperature and salinity dependent specific volume contribution that is + ! proportional to pressure [m3 kg-1 Pa-1] + real :: SV_TS2 ! A temperature and salinity dependent specific volume contribution that is + ! proportional to pressure**2 [m3 kg-1 Pa-2] + real :: SV_TS3 ! A temperature and salinity dependent specific volume contribution that is + ! proportional to pressure**3 [m3 kg-1 Pa-3] + real :: SV_0S0 ! Salinity dependent specific volume at the surface pressure and zero temperature [m3 kg-1] + integer :: j + + ! The following algorithm was published by Roquet et al. (2015), intended for use in non-Boussinesq ocean models. + do j=start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = pressure(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + SV_TS3 = SPV003 + (zs*SPV103 + zt*SPV013) + SV_TS2 = SPV002 + (zs*(SPV102 + zs*SPV202) & + + zt*(SPV012 + (zs*SPV112 + zt*SPV022)) ) + SV_TS1 = SPV001 + (zs*(SPV101 + zs*(SPV201 + zs*(SPV301 + zs*SPV401))) & + + zt*(SPV011 + (zs*(SPV111 + zs*(SPV211 + zs*SPV311)) & + + zt*(SPV021 + (zs*(SPV121 + zs*SPV221) & + + zt*(SPV031 + (zs*SPV131 + zt*SPV041)) )) )) ) + SV_TS0 = zt*(SPV010 & + + (zs*(SPV110 + zs*(SPV210 + zs*(SPV310 + zs*(SPV410 + zs*SPV510)))) & + + zt*(SPV020 + (zs*(SPV120 + zs*(SPV220 + zs*(SPV320 + zs*SPV420))) & + + zt*(SPV030 + (zs*(SPV130 + zs*(SPV230 + zs*SPV330)) & + + zt*(SPV040 + (zs*(SPV140 + zs*SPV240) & + + zt*(SPV050 + (zs*SPV150 + zt*SPV060)) )) )) )) ) ) + + SV_0S0 = SPV000 + zs*(SPV100 + zs*(SPV200 + zs*(SPV300 + zs*(SPV400 + zs*(SPV500 + zs*SPV600))))) + + SV_00p = zp*(V00 + zp*(V01 + zp*(V02 + zp*(V03 + zp*(V04 + zp*V05))))) + + if (present(spv_ref)) SV_0S0 = SV_0S0 - spv_ref + + SV_TS = (SV_TS0 + SV_0S0) + zp*(SV_TS1 + zp*(SV_TS2 + zp*SV_TS3)) + specvol(j) = SV_TS + SV_00p ! In situ specific volume [m3 kg-1] + enddo + +end subroutine calculate_spec_vol_array_Roquet_SpV + + +!> Compute the in situ density of sea water at a point (rho in [kg m-3]) from absolute +!! salinity (S [g kg-1]), conservative temperature (T [degC]) and pressure [Pa], using the +!! specific volume polynomial fit from Roquet et al. (2015). +subroutine calculate_density_scalar_Roquet_SpV(T, S, pressure, rho, rho_ref) + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: rho !< In situ density [kg m-3] + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pres0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv ! A 1-d array with the specific volume [m3 kg-1] + + T0(1) = T + S0(1) = S + pres0(1) = pressure + + if (present(rho_ref)) then + call calculate_spec_vol_array_Roquet_SpV(T0, S0, pres0, spv, 1, 1, spv_ref=1.0/rho_ref) + rho = -rho_ref**2*spv(1) / (rho_ref*spv(1) + 1.0) ! In situ density [kg m-3] + else + call calculate_spec_vol_array_Roquet_SpV(T0, S0, pres0, spv, 1, 1) + rho = 1.0 / spv(1) + endif + +end subroutine calculate_density_scalar_Roquet_SpV + +!> Compute an array of in situ densities of sea water (rho in [kg m-3]) from absolute +!! salinity (S [g kg-1]), conservative temperature (T [degC]) and pressure [Pa], +!! using the specific volume polynomial fit from Roquet et al. (2015). +subroutine calculate_density_array_Roquet_SpV(T, S, pressure, rho, start, npts, rho_ref) + real, dimension(:), intent(in) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in) :: S !< Absolute salinity [g kg-1] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: rho !< In situ density [kg m-3] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + + ! Local variables + real, dimension(size(T)) :: spv ! The specific volume [m3 kg-1] + integer :: j + + if (present(rho_ref)) then + call calculate_spec_vol_array_Roquet_SpV(T, S, pressure, spv, start, npts, spv_ref=1.0/rho_ref) + do j=start,start+npts-1 + rho(j) = -rho_ref**2*spv(j) / (rho_ref*spv(j) + 1.0) ! In situ density [kg m-3] + enddo + else + call calculate_spec_vol_array_Roquet_SpV(T, S, pressure, spv, start, npts) + do j=start,start+npts-1 + rho(j) = 1.0 / spv(j) ! In situ density [kg m-3] + enddo + endif + +end subroutine calculate_density_array_Roquet_SpV + +!> Return the partial derivatives of specific volume with temperature and salinity for 1-d array +!! inputs and outputs, using the specific volume polynomial fit from Roquet et al. (2015). +subroutine calculate_specvol_derivs_Roquet_SpV(T, S, pressure, dSV_dT, dSV_dS, start, npts) + real, intent(in), dimension(:) :: T !< Conservative temperature [degC] + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1] + real, intent(in), dimension(:) :: pressure !< Pressure [Pa] + real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! conservative temperature [m3 kg-1 degC-1] + real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! absolute salinity [m3 kg-1 ppt-1] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: dSVdzt0 ! A contribution to the partial derivative of specific volume with temperature + ! from temperature anomalies at the surface pressure [m3 kg-1 degC-1] + real :: dSVdzt1 ! A contribution to the partial derivative of specific volume with temperature + ! that is proportional to pressure [m3 kg-1 degC-1 Pa-1] + real :: dSVdzt2 ! A contribution to the partial derivative of specific volume with temperature + ! that is proportional to pressure**2 [m3 kg-1 degC-1 Pa-2] + real :: dSVdzt3 ! A contribution to the partial derivative of specific volume with temperature + ! that is proportional to pressure**3 [m3 kg-1 degC-1 Pa-3] + real :: dSVdzs0 ! A contribution to the partial derivative of specific volume with + ! salinity [m3 kg-1 ppt-1] from temperature anomalies at the surface pressure + real :: dSVdzs1 ! A contribution to the partial derivative of specific volume with + ! salinity [m3 kg-1 ppt-1 Pa-1] proportional to pressure + real :: dSVdzs2 ! A contribution to the partial derivative of specific volume with + ! salinity [m3 kg-1 ppt-1 Pa-2] proportional to pressure**2 + real :: dSVdzs3 ! A contribution to the partial derivative of specific volume with + ! salinity [m3 kg-1 ppt-1 Pa-3] proportional to pressure**3 + integer :: j + + do j=start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = pressure(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + ! Find the partial derivative of specific volume with temperature + dSVdzt3 = ALP003 + dSVdzt2 = ALP002 + (zs*ALP102 + zt*ALP012) + dSVdzt1 = ALP001 + (zs*(ALP101 + zs*(ALP201 + zs*ALP301)) & + + zt*(ALP011 + (zs*(ALP111 + zs*ALP211) & + + zt*(ALP021 + (zs*ALP121 + zt*ALP031)) )) ) + dSVdzt0 = ALP000 + (zs*(ALP100 + zs*(ALP200 + zs*(ALP300 + zs*(ALP400 + zs*ALP500)))) & + + zt*(ALP010 + (zs*(ALP110 + zs*(ALP210 + zs*(ALP310 + zs*ALP410))) & + + zt*(ALP020 + (zs*(ALP120 + zs*(ALP220 + zs*ALP320)) & + + zt*(ALP030 + (zt*(ALP040 + (zs*ALP140 + zt*ALP050)) & + + zs*(ALP130 + zs*ALP230) )) )) )) ) + + dSV_dT(j) = dSVdzt0 + zp*(dSVdzt1 + zp*(dSVdzt2 + zp*dSVdzt3)) + + ! Find the partial derivative of specific volume with salinity + dSVdzs3 = BET003 + dSVdzs2 = BET002 + (zs*BET102 + zt*BET012) + dSVdzs1 = BET001 + (zs*(BET101 + zs*(BET201 + zs*BET301)) & + + zt*(BET011 + (zs*(BET111 + zs*BET211) & + + zt*(BET021 + (zs*BET121 + zt*BET031)) )) ) + dSVdzs0 = BET000 + (zs*(BET100 + zs*(BET200 + zs*(BET300 + zs*(BET400 + zs*BET500)))) & + + zt*(BET010 + (zs*(BET110 + zs*(BET210 + zs*(BET310 + zs*BET410))) & + + zt*(BET020 + (zs*(BET120 + zs*(BET220 + zs*BET320)) & + + zt*(BET030 + (zt*(BET040 + (zs*BET140 + zt*BET050)) & + + zs*(BET130 + zs*BET230) )) )) )) ) + + ! The division by zs here is because zs = sqrt(S + S0), so dSV_dS = dzs_dS * dSV_dzs = (0.5 / zs) * dSV_dzs + dSV_dS(j) = (dSVdzs0 + zp*(dSVdzs1 + zp*(dSVdzs2 + zp * dSVdzs3))) / zs + enddo + +end subroutine calculate_specvol_derivs_Roquet_SpV + + +!> Compute an array of derivatives of densities of sea water with temperature (drho_dT in [kg m-3 degC-1]) +!! and salinity (drho_dS in [kg m-3 ppt-1]) from absolute salinity (S [g kg-1]), conservative temperature +!! (T [degC]) and pressure [Pa], using the specific volume polynomial fit from Roquet et al. (2015). +subroutine calculate_density_derivs_array_Roquet_SpV(T, S, pressure, drho_dT, drho_dS, start, npts) + real, intent(in), dimension(:) :: T !< Conservative temperature [degC] + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1] + real, intent(in), dimension(:) :: pressure !< pressure [Pa] + real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with + !! conservative temperature [kg m-3 degC-1] + real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with + !! absolute salinity [kg m-3 ppt-1] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + + ! Local variables + real, dimension(size(T)) :: specvol ! The specific volume [m3 kg-1] + real, dimension(size(T)) :: dSV_dT ! The partial derivative of specific volume with + ! conservative temperature [m3 kg-1 degC-1] + real, dimension(size(T)) :: dSV_dS ! The partial derivative of specific volume with + ! absolute salinity [m3 kg-1 ppt-1] + real :: rho ! The in situ density [kg m-3] + integer :: j + + call calculate_spec_vol_array_Roquet_SpV(T, S, pressure, specvol, start, npts) + call calculate_specvol_derivs_Roquet_SpV(T, S, pressure, dSV_dT, dSV_dS, start, npts) + + do j=start,start+npts-1 + rho = 1.0 / specvol(j) + drho_dT(j) = -dSv_dT(j) * rho**2 + drho_dS(j) = -dSv_dS(j) * rho**2 + enddo + +end subroutine calculate_density_derivs_array_Roquet_SpV + +!> Wrapper to calculate_density_derivs_array_Roquet_SpV for scalar inputs +subroutine calculate_density_derivs_scalar_Roquet_SpV(T, S, pressure, drho_dt, drho_ds) + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: drho_dT !< The partial derivative of density with + !! conservative temperature [kg m-3 degC-1] + real, intent(out) :: drho_dS !< The partial derivative of density with + !! absolute salinity [kg m-3 ppt-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pres0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! A 1-d array with a copy of the derivative of density + ! with conservative temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! A 1-d array with a copy of the derivative of density + ! with absolute salinity [kg m-3 ppt-1] + + T0(1) = T + S0(1) = S + pres0(1) = pressure + + call calculate_density_derivs_array_Roquet_SpV(T0, S0, pres0, drdt0, drds0, 1, 1) + drho_dt = drdt0(1) + drho_ds = drds0(1) +end subroutine calculate_density_derivs_scalar_Roquet_SpV + +!> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility +!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), +!! conservative temperature (T [degC]), and pressure [Pa], using the specific volume +!! polynomial fit from Roquet et al. (2015). +subroutine calculate_compress_Roquet_SpV(T, S, pressure, rho, drho_dp, start, npts) + real, intent(in), dimension(:) :: T !< Conservative temperature [degC] + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1] + real, intent(in), dimension(:) :: pressure !< pressure [Pa] + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3] + real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! [s2 m-2] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: dSV_00p_dp ! Derivative of the pressure-dependent reference specific volume profile with + ! pressure [m3 kg-1 Pa-1] + real :: dSV_TS_dp ! Derivative of the specific volume anomaly from the reference profile with + ! pressure [m3 kg-1 Pa-1] + real :: SV_00p ! A pressure-dependent but temperature and salinity independent contribution to + ! specific volume at the reference temperature and salinity [m3 kg-1] + real :: SV_TS ! specific volume without a pressure-dependent contribution [m3 kg-1] + real :: SV_TS0 ! A contribution to specific volume from temperature and salinity anomalies at + ! the surface pressure [m3 kg-1] + real :: SV_TS1 ! A temperature and salinity dependent specific volume contribution that is + ! proportional to pressure [m3 kg-1 Pa-1] + real :: SV_TS2 ! A temperature and salinity dependent specific volume contribution that is + ! proportional to pressure**2 [m3 kg-1 Pa-2] + real :: SV_TS3 ! A temperature and salinity dependent specific volume contribution that is + ! proportional to pressure**3 [m3 kg-1 Pa-3] + real :: SV_0S0 ! Salinity dependent specific volume at the surface pressure and zero temperature [m3 kg-1] + real :: dSpecVol_dp ! The partial derivative of specific volume with pressure [m3 kg-1 Pa-1] + integer :: j + + ! The following algorithm was published by Roquet et al. (2015), intended for use + ! with NEMO, but it is not necessarily the algorithm used in NEMO ocean model. + do j=start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = pressure(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + SV_TS3 = SPV003 + (zs*SPV103 + zt*SPV013) + SV_TS2 = SPV002 + (zs*(SPV102 + zs*SPV202) & + + zt*(SPV012 + (zs*SPV112 + zt*SPV022)) ) + SV_TS1 = SPV001 + (zs*(SPV101 + zs*(SPV201 + zs*(SPV301 + zs*SPV401))) & + + zt*(SPV011 + (zs*(SPV111 + zs*(SPV211 + zs*SPV311)) & + + zt*(SPV021 + (zs*(SPV121 + zs*SPV221) & + + zt*(SPV031 + (zs*SPV131 + zt*SPV041)) )) )) ) + + SV_TS0 = zt*(SPV010 & + + (zs*(SPV110 + zs*(SPV210 + zs*(SPV310 + zs*(SPV410 + zs*SPV510)))) & + + zt*(SPV020 + (zs*(SPV120 + zs*(SPV220 + zs*(SPV320 + zs*SPV420))) & + + zt*(SPV030 + (zs*(SPV130 + zs*(SPV230 + zs*SPV330)) & + + zt*(SPV040 + (zs*(SPV140 + zs*SPV240) & + + zt*(SPV050 + (zs*SPV150 + zt*SPV060)) )) )) )) ) ) + + SV_0S0 = SPV000 + zs*(SPV100 + zs*(SPV200 + zs*(SPV300 + zs*(SPV400 + zs*(SPV500 + zs*SPV600))))) + + SV_00p = zp*(V00 + zp*(V01 + zp*(V02 + zp*(V03 + zp*(V04 + zp*V05))))) + + SV_TS = (SV_TS0 + SV_0S0) + zp*(SV_TS1 + zp*(SV_TS2 + zp*SV_TS3)) + ! specvol = SV_TS + SV_00p ! In situ specific volume [m3 kg-1] + rho(j) = 1.0 / (SV_TS + SV_00p) ! In situ density [kg m-3] + + dSV_00p_dp = V00 + zp*(2.*V01 + zp*(3.*V02 + zp*(4.*V03 + zp*(5.*V04 + zp*(6.*V05))))) + dSV_TS_dp = SV_TS1 + zp*(2.*SV_TS2 + zp*(3.*SV_TS3)) + dSpecVol_dp = dSV_TS_dp + dSV_00p_dp ! [m3 kg-1 Pa-1] + drho_dp(j) = -dSpecVol_dp * rho(j)**2 ! Compressibility [s2 m-2] + + enddo +end subroutine calculate_compress_Roquet_SpV + + +!> Second derivatives of specific volume with respect to temperature, salinity, and pressure for a +!! 1-d array inputs and outputs using the specific volume polynomial fit from Roquet et al. (2015). +subroutine calc_spec_vol_second_derivs_array_Roquet_SpV(T, S, P, dSV_ds_ds, dSV_ds_dt, dSV_dt_dt, & + dSV_ds_dp, dSV_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in ) :: S !< Absolute salinity [g kg-1] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: dSV_ds_ds !< Second derivative of specific volume with respect + !! to salinity [m3 kg-1 ppt-2] + real, dimension(:), intent(inout) :: dSV_ds_dt !< Second derivative of specific volume with respect + !! to salinity and temperature [m3 kg-1 ppt-1 degC-1] + real, dimension(:), intent(inout) :: dSV_dt_dt !< Second derivative of specific volume with respect + !! to temperature [m3 kg-1 degC-2] + real, dimension(:), intent(inout) :: dSV_ds_dp !< Second derivative of specific volume with respect to pressure + !! and salinity [m3 kg-1 ppt-1 Pa-1] + real, dimension(:), intent(inout) :: dSV_dt_dp !< Second derivative of specific volume with respect to pressure + !! and temperature [m3 kg-1 degC-1 Pa-1] + integer, intent(in ) :: start !< The starting index for calculations + integer, intent(in ) :: npts !< The number of values to calculate + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: I_s ! The inverse of zs [nondim] + real :: d2SV_p0 ! A contribution to one of the second derivatives that is independent of pressure [various] + real :: d2SV_p1 ! A contribution to one of the second derivatives that is proportional to pressure [various] + real :: d2SV_p2 ! A contribution to one of the second derivatives that is proportional to pressure**2 [various] + real :: d2SV_p3 ! A contribution to one of the second derivatives that is proportional to pressure**3 [various] + integer :: j + + do j = start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = P(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + I_s = 1.0 / zs + + ! Find dSV_ds_ds + d2SV_p3 = -SPV103*I_s**2 + d2SV_p2 = -(SPV102 + zt*SPV112)*I_s**2 + d2SV_p1 = (3.*SPV301 + (zt*(3.*SPV311) + zs*(8.*SPV401))) & + - ( SPV101 + zt*(SPV111 + zt*(SPV121 + zt*SPV131)) )*I_s**2 + d2SV_p0 = (3.*SPV300 + (zs*(8.*SPV400 + zs*(15.*SPV500 + zs*(24.*SPV600))) & + + zt*(3.*SPV310 + (zs*(8.*SPV410 + zs*(15.*SPV510)) & + + zt*(3.*SPV320 + (zs*(8.*SPV420) + zt*(3.*SPV330))) )) )) & + - (SPV100 + zt*(SPV110 + zt*(SPV120 + zt*(SPV130 + zt*(SPV140 + zt*SPV150)))) )*I_s**2 + dSV_dS_dS(j) = (0.5*r1_S0)**2 * ((d2SV_p0 + zp*(d2SV_p1 + zp*(d2SV_p2 + zp*d2SV_p3))) * I_s) + + ! Find dSV_ds_dt + d2SV_p2 = SPV112 + d2SV_p1 = SPV111 + (zs*(2.*SPV211 + zs*(3.*SPV311)) & + + zt*(2.*SPV121 + (zs*(4.*SPV221) + zt*(3.*SPV131))) ) + d2SV_p0 = SPV110 + (zs*(2.*SPV210 + zs*(3.*SPV310 + zs*(4.*SPV410 + zs*(5.*SPV510)))) & + + zt*(2.*SPV120 + (zs*(4.*SPV220 + zs*(6.*SPV320 + zs*(8.*SPV420))) & + + zt*(3.*SPV130 + (zs*(6.*SPV230 + zs*(9.*SPV330)) & + + zt*(4.*SPV140 + (zs*(8.*SPV240) & + + zt*(5.*SPV150))) )) )) ) + dSV_ds_dt(j) = (0.5*r1_S0) * ((d2SV_p0 + zp*(d2SV_p1 + zp*d2SV_p2)) * I_s) + + ! Find dSV_dt_dt + d2SV_p2 = 2.*SPV022 + d2SV_p1 = 2.*SPV021 + (zs*(2.*SPV121 + zs*(2.*SPV221)) & + + zt*(6.*SPV031 + (zs*(6.*SPV131) + zt*(12.*SPV041))) ) + d2SV_p0 = 2.*SPV020 + (zs*(2.*SPV120 + zs*( 2.*SPV220 + zs*( 2.*SPV320 + zs * (2.*SPV420)))) & + + zt*(6.*SPV030 + (zs*( 6.*SPV130 + zs*( 6.*SPV230 + zs * (6.*SPV330))) & + + zt*(12.*SPV040 + (zs*(12.*SPV140 + zs *(12.*SPV240)) & + + zt*(20.*SPV050 + (zs*(20.*SPV150) & + + zt*(30.*SPV060) )) )) )) ) + dSV_dt_dt(j) = d2SV_p0 + zp*(d2SV_p1 + zp*d2SV_p2) + + ! Find dSV_ds_dp + d2SV_p2 = 3.*SPV103 + d2SV_p1 = 2.*SPV102 + (zs*(4.*SPV202) + zt*(2.*SPV112)) + d2SV_p0 = SPV101 + (zs*(2.*SPV201 + zs*(3.*SPV301 + zs*(4.*SPV401))) & + + zt*(SPV111 + (zs*(2.*SPV211 + zs*(3.*SPV311)) & + + zt*( SPV121 + (zs*(2.*SPV221) + zt*SPV131)) )) ) + dSV_ds_dp(j) = ((d2SV_p0 + zp*(d2SV_p1 + zp*d2SV_p2)) * I_s) * (0.5*r1_S0) + + ! Find dSV_dt_dp + d2SV_p2 = 3.*SPV013 + d2SV_p1 = 2.*SPV012 + (zs*(2.*SPV112) + zt*(4.*SPV022)) + d2SV_p0 = SPV011 + (zs*(SPV111 + zs*( SPV211 + zs* SPV311)) & + + zt*(2.*SPV021 + (zs*(2.*SPV121 + zs*(2.*SPV221)) & + + zt*(3.*SPV031 + (zs*(3.*SPV131) + zt*(4.*SPV041))) )) ) + dSV_dt_dp(j) = d2SV_p0 + zp*(d2SV_p1 + zp*d2SV_p2) + enddo + +end subroutine calc_spec_vol_second_derivs_array_Roquet_SpV + + +!> Second derivatives of density with respect to temperature, salinity, and pressure for a +!! 1-d array inputs and outputs using the specific volume polynomial fit from Roquet et al. (2015). +subroutine calculate_density_second_derivs_array_Roquet_SpV(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in ) :: S !< Absolute salinity [g kg-1] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Second derivative of density with respect + !! to salinity [kg m-3 ppt-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Second derivative of density with respect + !! to salinity and temperature [kg m-3 ppt-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Second derivative of density with respect + !! to temperature [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Second derivative of density with respect to pressure + !! and salinity [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Second derivative of density with respect to pressure + !! and temperature [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< The starting index for calculations + integer, intent(in ) :: npts !< The number of values to calculate + + ! Local variables + real, dimension(size(T)) :: rho ! The in situ density [kg m-3] + real, dimension(size(T)) :: drho_dp ! The partial derivative of density with pressure + ! (also the inverse of the square of sound speed) [s2 m-2] + real, dimension(size(T)) :: dSV_dT ! The partial derivative of specific volume with + ! conservative temperature [m3 kg-1 degC-1] + real, dimension(size(T)) :: dSV_dS ! The partial derivative of specific volume with + ! absolute salinity [m3 kg-1 ppt-1] + real, dimension(size(T)) :: dSV_ds_ds ! Second derivative of specific volume with respect + ! to salinity [m3 kg-1 ppt-2] + real, dimension(size(T)) :: dSV_ds_dt ! Second derivative of specific volume with respect + ! to salinity and temperature [m3 kg-1 ppt-1 degC-1] + real, dimension(size(T)) :: dSV_dt_dt ! Second derivative of specific volume with respect + ! to temperature [m3 kg-1 degC-2] + real, dimension(size(T)) :: dSV_ds_dp ! Second derivative of specific volume with respect to pressure + ! and salinity [m3 kg-1 ppt-1 Pa-1] + real, dimension(size(T)) :: dSV_dt_dp ! Second derivative of specific volume with respect to pressure + ! and temperature [m3 kg-1 degC-1 Pa-1] + integer :: j + + call calc_spec_vol_second_derivs_array_Roquet_SpV(T, S, P, dSV_ds_ds, dSV_ds_dt, dSV_dt_dt, & + dSV_ds_dp, dSV_dt_dp, start, npts) + call calculate_specvol_derivs_Roquet_SpV(T, S, P, dSV_dT, dSV_dS, start, npts) + call calculate_compress_Roquet_SpV(T, S, P, rho, drho_dp, start, npts) + + do j = start,start+npts-1 + ! Find drho_ds_ds + drho_dS_dS(j) = rho(j)**2 * (2.0*rho(j)*dSV_dS(j)**2 - dSV_dS_dS(j)) + + ! Find drho_ds_dt + drho_ds_dt(j) = rho(j)**2 * (2.0*rho(j)*(dSV_dT(j)*dSV_dS(j)) - dSV_dS_dT(j)) + + ! Find drho_dt_dt + drho_dT_dT(j) = rho(j)**2 * (2.0*rho(j)*dSV_dT(j)**2 - dSV_dT_dT(j)) + + ! Find drho_ds_dp + drho_ds_dp(j) = -rho(j) * (2.0*dSV_dS(j) * drho_dp(j) + rho(j) * dSV_dS_dp(j)) + + ! Find drho_dt_dp + drho_dt_dp(j) = -rho(j) * (2.0*dSV_dT(j) * drho_dp(j) + rho(j) * dSV_dT_dp(j)) + enddo + +end subroutine calculate_density_second_derivs_array_Roquet_SpV + +!> Second derivatives of density with respect to temperature, salinity, and pressure for scalar inputs. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_second_derivs_scalar_Roquet_SpV(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Conservative temperature [degC] + real, intent(in ) :: S !< Absolute salinity [g kg-1] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Second derivative of density with respect + !! to salinity [kg m-3 ppt-2] + real, intent( out) :: drho_ds_dt !< Second derivative of density with respect + !! to salinity and temperature [kg m-3 ppt-1 degC-1] + real, intent( out) :: drho_dt_dt !< Second derivative of density with respect + !! to temperature [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Second derivative of density with respect to pressure + !! and salinity [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] + real, intent( out) :: drho_dt_dp !< Second derivative of density with respect to pressure + !! and temperature [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [g kg-1] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 ppt-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 ppt-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T + S0(1) = S + P0(1) = P + call calculate_density_second_derivs_array_Roquet_SpV(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) + drho_ds_dt = drdsdt(1) + drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) + drho_dt_dp = drdtdp(1) + +end subroutine calculate_density_second_derivs_scalar_Roquet_SpV + +!> Return the range of temperatures, salinities and pressures for which the Roquet et al. (2015) +!! expression for specific volume has been fitted to observations. Care should be taken when +!! applying this equation of state outside of its fit range. +subroutine EoS_fit_range_Roquet_SpV(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum conservative temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum conservative temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum absolute salinity over which this EoS is fitted [g kg-1] + real, optional, intent(out) :: S_max !< The maximum absolute salinity over which this EoS is fitted [g kg-1] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -6.0 + if (present(T_max)) T_max = 40.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 42.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 1.0e8 + +end subroutine EoS_fit_range_Roquet_SpV + +!> \namespace mom_eos_Roquet_SpV +!! +!! \section section_EOS_Roquet_SpV NEMO equation of state +!! +!! Fabien Roquet and colleagues developed this equation of state using a simple polynomial fit +!! to the TEOS-10 equation of state expressions for specific, for efficiency when used with a +!! non-Boussinesq ocean model. This particular equation of state is a balance between an +!! accuracy that matches the TEOS-10 density to better than observational uncertainty with a +!! polynomial form that can be evaluated quickly despite having 55 terms. +!! +!! \subsection section_EOS_Roquet_Spv_references References +!! +!! Roquet, F., Madec, G., McDougall, T. J., and Barker, P. M., 2015: +!! Accurate polynomial expressions for the density and specific volume +!! of seawater using the TEOS-10 standard. Ocean Modelling, 90:29-43. + +end module MOM_EOS_Roquet_Spv diff --git a/src/equation_of_state/MOM_EOS_Roquet_rho.F90 b/src/equation_of_state/MOM_EOS_Roquet_rho.F90 new file mode 100644 index 0000000000..6d7a7a143e --- /dev/null +++ b/src/equation_of_state/MOM_EOS_Roquet_rho.F90 @@ -0,0 +1,633 @@ +!> The equation of state using the expressions of Roquet et al. (2015) that are used in NEMO +module MOM_EOS_Roquet_rho + +! This file is part of MOM6. See LICENSE.md for the license. + +!use gsw_mod_toolbox, only : gsw_sr_from_sp, gsw_ct_from_pt + +implicit none ; private + +public calculate_compress_Roquet_rho, calculate_density_Roquet_rho +public calculate_density_derivs_Roquet_rho +public calculate_density_scalar_Roquet_rho, calculate_density_array_Roquet_rho +public calculate_density_second_derivs_Roquet_rho, EoS_fit_range_Roquet_rho + +!> Compute the in situ density of sea water [kg m-3], or its anomaly with respect to +!! a reference density, from absolute salinity [g kg-1], conservative temperature [degC], +!! and pressure [Pa], using the expressions for density from Roquet et al. (2015) +interface calculate_density_Roquet_rho + module procedure calculate_density_scalar_Roquet_rho, calculate_density_array_Roquet_rho +end interface calculate_density_Roquet_rho + +!> For a given thermodynamic state, return the derivatives of density with conservative temperature +!! and absolute salinity, using the expressions for density from Roquet et al. (2015) +interface calculate_density_derivs_Roquet_rho + module procedure calculate_density_derivs_scalar_Roquet_rho, calculate_density_derivs_array_Roquet_rho +end interface calculate_density_derivs_Roquet_rho + +!> Compute the second derivatives of density with various combinations of temperature, +!! salinity, and pressure using the expressions for density from Roquet et al. (2015) +interface calculate_density_second_derivs_Roquet_rho + module procedure calculate_density_second_derivs_scalar_Roquet_rho + module procedure calculate_density_second_derivs_array_Roquet_rho +end interface calculate_density_second_derivs_Roquet_rho + +real, parameter :: Pa2kb = 1.e-8 !< Conversion factor between Pa and kbar [kbar Pa-1] +!>@{ Parameters in the Roquet_rho (Roquet density) equation of state +real, parameter :: rdeltaS = 32. ! An offset to salinity before taking its square root [g kg-1] +real, parameter :: r1_S0 = 0.875/35.16504 ! The inverse of a plausible range of oceanic salinities [kg g-1] +real, parameter :: I_Ts = 0.025 ! The inverse of a plausible range of oceanic temperatures [degC-1] + +! The following are the coefficients of the fit to the reference density profile (rho00p) as a function of +! pressure (P), with a contribution R0c * P**(c+1). The nomenclature follows Roquet. +real, parameter :: R00 = 4.6494977072e+01*Pa2kb ! rho00p P coef. [kg m-3 Pa-1] +real, parameter :: R01 = -5.2099962525*Pa2kb**2 ! rho00p P**2 coef. [kg m-3 Pa-2] +real, parameter :: R02 = 2.2601900708e-01*Pa2kb**3 ! rho00p P**3 coef. [kg m-3 Pa-3] +real, parameter :: R03 = 6.4326772569e-02*Pa2kb**4 ! rho00p P**4 coef. [kg m-3 Pa-4] +real, parameter :: R04 = 1.5616995503e-02*Pa2kb**5 ! rho00p P**5 coef. [kg m-3 Pa-5] +real, parameter :: R05 = -1.7243708991e-03*Pa2kb**6 ! rho00p P**6 coef. [kg m-3 Pa-6] + +! The following are coefficients of contributions to density as a function of the square root +! of normalized salinity with an offset (zs), temperature (T) and pressure (P), with a contribution +! EOSabc * zs**a * T**b * P**c. The numbers here are copied directly from Roquet et al. (2015), but +! the expressions here do not use the same nondimensionalization for pressure or temperature as they do. +real, parameter :: EOS000 = 8.0189615746e+02 ! A constant density contribution [kg m-3] +real, parameter :: EOS100 = 8.6672408165e+02 ! EoS zs coef. [kg m-3] +real, parameter :: EOS200 = -1.7864682637e+03 ! EoS zs**2 coef. [kg m-3] +real, parameter :: EOS300 = 2.0375295546e+03 ! EoS zs**3 coef. [kg m-3] +real, parameter :: EOS400 = -1.2849161071e+03 ! EoS zs**4 coef. [kg m-3] +real, parameter :: EOS500 = 4.3227585684e+02 ! EoS zs**5 coef. [kg m-3] +real, parameter :: EOS600 = -6.0579916612e+01 ! EoS zs**6 coef. [kg m-3] +real, parameter :: EOS010 = 2.6010145068e+01*I_Ts ! EoS T coef. [kg m-3 degC-1] +real, parameter :: EOS110 = -6.5281885265e+01*I_Ts ! EoS zs * T coef. [kg m-3 degC-1] +real, parameter :: EOS210 = 8.1770425108e+01*I_Ts ! EoS zs**2 * T coef. [kg m-3 degC-1] +real, parameter :: EOS310 = -5.6888046321e+01*I_Ts ! EoS zs**3 * T coef. [kg m-3 degC-1] +real, parameter :: EOS410 = 1.7681814114e+01*I_Ts ! EoS zs**2 * T coef. [kg m-3 degC-1] +real, parameter :: EOS510 = -1.9193502195*I_Ts ! EoS zs**5 * T coef. [kg m-3 degC-1] +real, parameter :: EOS020 = -3.7074170417e+01*I_Ts**2 ! EoS T**2 coef. [kg m-3 degC-2] +real, parameter :: EOS120 = 6.1548258127e+01*I_Ts**2 ! EoS zs * T**2 coef. [kg m-3 degC-2] +real, parameter :: EOS220 = -6.0362551501e+01*I_Ts**2 ! EoS zs**2 * T**2 coef. [kg m-3 degC-2] +real, parameter :: EOS320 = 2.9130021253e+01*I_Ts**2 ! EoS zs**3 * T**2 coef. [kg m-3 degC-2] +real, parameter :: EOS420 = -5.4723692739*I_Ts**2 ! EoS zs**4 * T**2 coef. [kg m-3 degC-2] +real, parameter :: EOS030 = 2.1661789529e+01*I_Ts**3 ! EoS T**3 coef. [kg m-3 degC-3] +real, parameter :: EOS130 = -3.3449108469e+01*I_Ts**3 ! EoS zs * T**3 coef. [kg m-3 degC-3] +real, parameter :: EOS230 = 1.9717078466e+01*I_Ts**3 ! EoS zs**2 * T**3 coef. [kg m-3 degC-3] +real, parameter :: EOS330 = -3.1742946532*I_Ts**3 ! EoS zs**3 * T**3 coef. [kg m-3 degC-3] +real, parameter :: EOS040 = -8.3627885467*I_Ts**4 ! EoS T**4 coef. [kg m-3 degC-4] +real, parameter :: EOS140 = 1.1311538584e+01*I_Ts**4 ! EoS zs * T**4 coef. [kg m-3 degC-4] +real, parameter :: EOS240 = -5.3563304045*I_Ts**4 ! EoS zs**2 * T**4 coef. [kg m-3 degC-4] +real, parameter :: EOS050 = 5.4048723791e-01*I_Ts**5 ! EoS T**5 coef. [kg m-3 degC-5] +real, parameter :: EOS150 = 4.8169980163e-01*I_Ts**5 ! EoS zs * T**5 coef. [kg m-3 degC-5] +real, parameter :: EOS060 = -1.9083568888e-01*I_Ts**6 ! EoS T**6 [kg m-3 degC-6] +real, parameter :: EOS001 = 1.9681925209e+01*Pa2kb ! EoS P coef. [kg m-3 Pa-1] +real, parameter :: EOS101 = -4.2549998214e+01*Pa2kb ! EoS zs * P coef. [kg m-3 Pa-1] +real, parameter :: EOS201 = 5.0774768218e+01*Pa2kb ! EoS zs**2 * P coef. [kg m-3 Pa-1] +real, parameter :: EOS301 = -3.0938076334e+01*Pa2kb ! EoS zs**3 * P coef. [kg m-3 Pa-1] +real, parameter :: EOS401 = 6.6051753097*Pa2kb ! EoS zs**4 * P coef. [kg m-3 Pa-1] +real, parameter :: EOS011 = -1.3336301113e+01*(I_Ts*Pa2kb) ! EoS T * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: EOS111 = -4.4870114575*(I_Ts*Pa2kb) ! EoS zs * T * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: EOS211 = 5.0042598061*(I_Ts*Pa2kb) ! EoS zs**2 * T * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: EOS311 = -6.5399043664e-01*(I_Ts*Pa2kb) ! EoS zs**3 * T * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: EOS021 = 6.7080479603*(I_Ts**2*Pa2kb) ! EoS T**2 * P coef. [kg m-3 degC-2 Pa-1] +real, parameter :: EOS121 = 3.5063081279*(I_Ts**2*Pa2kb) ! EoS zs * T**2 * P coef. [kg m-3 degC-2 Pa-1] +real, parameter :: EOS221 = -1.8795372996*(I_Ts**2*Pa2kb) ! EoS zs**2 * T**2 * P coef. [kg m-3 degC-2 Pa-1] +real, parameter :: EOS031 = -2.4649669534*(I_Ts**3*Pa2kb) ! EoS T**3 * P coef. [kg m-3 degC-3 Pa-1] +real, parameter :: EOS131 = -5.5077101279e-01*(I_Ts**3*Pa2kb) ! EoS zs * T**3 * P coef. [kg m-3 degC-3 Pa-1] +real, parameter :: EOS041 = 5.5927935970e-01*(I_Ts**4*Pa2kb) ! EoS T**4 * P coef. [kg m-3 degC-4 Pa-1] +real, parameter :: EOS002 = 2.0660924175*Pa2kb**2 ! EoS P**2 coef. [kg m-3 Pa-2] +real, parameter :: EOS102 = -4.9527603989*Pa2kb**2 ! EoS zs * P**2 coef. [kg m-3 Pa-2] +real, parameter :: EOS202 = 2.5019633244*Pa2kb**2 ! EoS zs**2 * P**2 coef. [kg m-3 Pa-2] +real, parameter :: EOS012 = 2.0564311499*(I_Ts*Pa2kb**2) ! EoS T * P**2 coef. [kg m-3 degC-1 Pa-2] +real, parameter :: EOS112 = -2.1311365518e-01*(I_Ts*Pa2kb**2) ! EoS zs * T * P**2 coef. [kg m-3 degC-1 Pa-2] +real, parameter :: EOS022 = -1.2419983026*(I_Ts**2*Pa2kb**2) ! EoS T**2 * P**2 coef. [kg m-3 degC-2 Pa-2] +real, parameter :: EOS003 = -2.3342758797e-02*Pa2kb**3 ! EoS P**3 coef. [kg m-3 Pa-3] +real, parameter :: EOS103 = -1.8507636718e-02*Pa2kb**3 ! EoS zs * P**3 coef. [kg m-3 Pa-3] +real, parameter :: EOS013 = 3.7969820455e-01*(I_Ts*Pa2kb**3) ! EoS T * P**3 coef. [kg m-3 degC-1 Pa-3] + +real, parameter :: ALP000 = EOS010 ! Constant in the drho_dT fit [kg m-3 degC-1] +real, parameter :: ALP100 = EOS110 ! drho_dT fit zs coef. [kg m-3 degC-1] +real, parameter :: ALP200 = EOS210 ! drho_dT fit zs**2 coef. [kg m-3 degC-1] +real, parameter :: ALP300 = EOS310 ! drho_dT fit zs**3 coef. [kg m-3 degC-1] +real, parameter :: ALP400 = EOS410 ! drho_dT fit zs**4 coef. [kg m-3 degC-1] +real, parameter :: ALP500 = EOS510 ! drho_dT fit zs**5 coef. [kg m-3 degC-1] +real, parameter :: ALP010 = 2.*EOS020 ! drho_dT fit T coef. [kg m-3 degC-2] +real, parameter :: ALP110 = 2.*EOS120 ! drho_dT fit zs * T coef. [kg m-3 degC-2] +real, parameter :: ALP210 = 2.*EOS220 ! drho_dT fit zs**2 * T coef. [kg m-3 degC-2] +real, parameter :: ALP310 = 2.*EOS320 ! drho_dT fit zs**3 * T coef. [kg m-3 degC-2] +real, parameter :: ALP410 = 2.*EOS420 ! drho_dT fit zs**4 * T coef. [kg m-3 degC-2] +real, parameter :: ALP020 = 3.*EOS030 ! drho_dT fit T**2 coef. [kg m-3 degC-3] +real, parameter :: ALP120 = 3.*EOS130 ! drho_dT fit zs * T**2 coef. [kg m-3 degC-3] +real, parameter :: ALP220 = 3.*EOS230 ! drho_dT fit zs**2 * T**2 coef. [kg m-3 degC-3] +real, parameter :: ALP320 = 3.*EOS330 ! drho_dT fit zs**3 * T**2 coef. [kg m-3 degC-3] +real, parameter :: ALP030 = 4.*EOS040 ! drho_dT fit T**3 coef. [kg m-3 degC-4] +real, parameter :: ALP130 = 4.*EOS140 ! drho_dT fit zs * T**3 coef. [kg m-3 degC-4] +real, parameter :: ALP230 = 4.*EOS240 ! drho_dT fit zs**2 * T**3 coef. [kg m-3 degC-4] +real, parameter :: ALP040 = 5.*EOS050 ! drho_dT fit T**4 coef. [kg m-3 degC-5] +real, parameter :: ALP140 = 5.*EOS150 ! drho_dT fit zs* * T**4 coef. [kg m-3 degC-5] +real, parameter :: ALP050 = 6.*EOS060 ! drho_dT fit T**5 coef. [kg m-3 degC-6] +real, parameter :: ALP001 = EOS011 ! drho_dT fit P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: ALP101 = EOS111 ! drho_dT fit zs * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: ALP201 = EOS211 ! drho_dT fit zs**2 * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: ALP301 = EOS311 ! drho_dT fit zs**3 * P coef. [kg m-3 degC-1 Pa-1] +real, parameter :: ALP011 = 2.*EOS021 ! drho_dT fit T * P coef. [kg m-3 degC-2 Pa-1] +real, parameter :: ALP111 = 2.*EOS121 ! drho_dT fit zs * T * P coef. [kg m-3 degC-2 Pa-1] +real, parameter :: ALP211 = 2.*EOS221 ! drho_dT fit zs**2 * T * P coef. [kg m-3 degC-2 Pa-1] +real, parameter :: ALP021 = 3.*EOS031 ! drho_dT fit T**2 * P coef. [kg m-3 degC-3 Pa-1] +real, parameter :: ALP121 = 3.*EOS131 ! drho_dT fit zs * T**2 * P coef. [kg m-3 degC-3 Pa-1] +real, parameter :: ALP031 = 4.*EOS041 ! drho_dT fit T**3 * P coef. [kg m-3 degC-4 Pa-1] +real, parameter :: ALP002 = EOS012 ! drho_dT fit P**2 coef. [kg m-3 degC-1 Pa-2] +real, parameter :: ALP102 = EOS112 ! drho_dT fit zs * P**2 coef. [kg m-3 degC-1 Pa-2] +real, parameter :: ALP012 = 2.*EOS022 ! drho_dT fit T * P**2 coef. [kg m-3 degC-2 Pa-2] +real, parameter :: ALP003 = EOS013 ! drho_dT fit P**3 coef. [kg m-3 degC-1 Pa-3] + +real, parameter :: BET000 = 0.5*EOS100*r1_S0 ! Constant in the drho_dS fit [kg m-3 ppt-1] +real, parameter :: BET100 = EOS200*r1_S0 ! drho_dS fit zs coef. [kg m-3 ppt-1] +real, parameter :: BET200 = 1.5*EOS300*r1_S0 ! drho_dS fit zs**2 coef. [kg m-3 ppt-1] +real, parameter :: BET300 = 2.0*EOS400*r1_S0 ! drho_dS fit zs**3 coef. [kg m-3 ppt-1] +real, parameter :: BET400 = 2.5*EOS500*r1_S0 ! drho_dS fit zs**4 coef. [kg m-3 ppt-1] +real, parameter :: BET500 = 3.0*EOS600*r1_S0 ! drho_dS fit zs**5 coef. [kg m-3 ppt-1] +real, parameter :: BET010 = 0.5*EOS110*r1_S0 ! drho_dS fit T coef. [kg m-3 ppt-1 degC-1] +real, parameter :: BET110 = EOS210*r1_S0 ! drho_dS fit zs * T coef. [kg m-3 ppt-1 degC-1] +real, parameter :: BET210 = 1.5*EOS310*r1_S0 ! drho_dS fit zs**2 * T coef. [kg m-3 ppt-1 degC-1] +real, parameter :: BET310 = 2.0*EOS410*r1_S0 ! drho_dS fit zs**3 * T coef. [kg m-3 ppt-1 degC-1] +real, parameter :: BET410 = 2.5*EOS510*r1_S0 ! drho_dS fit zs**4 * T coef. [kg m-3 ppt-1 degC-1] +real, parameter :: BET020 = 0.5*EOS120*r1_S0 ! drho_dS fit T**2 coef. [kg m-3 ppt-1 degC-2] +real, parameter :: BET120 = EOS220*r1_S0 ! drho_dS fit zs * T**2 coef. [kg m-3 ppt-1 degC-2] +real, parameter :: BET220 = 1.5*EOS320*r1_S0 ! drho_dS fit zs**2 * T**2 coef. [kg m-3 ppt-1 degC-2] +real, parameter :: BET320 = 2.0*EOS420*r1_S0 ! drho_dS fit zs**3 * T**2 coef. [kg m-3 ppt-1 degC-2] +real, parameter :: BET030 = 0.5*EOS130*r1_S0 ! drho_dS fit T**3 coef. [kg m-3 ppt-1 degC-3] +real, parameter :: BET130 = EOS230*r1_S0 ! drho_dS fit zs * T**3 coef. [kg m-3 ppt-1 degC-3] +real, parameter :: BET230 = 1.5*EOS330*r1_S0 ! drho_dS fit zs**2 * T**3 coef. [kg m-3 ppt-1 degC-3] +real, parameter :: BET040 = 0.5*EOS140*r1_S0 ! drho_dS fit T**4 coef. [kg m-3 ppt-1 degC-4] +real, parameter :: BET140 = EOS240*r1_S0 ! drho_dS fit zs * T**4 coef. [kg m-3 ppt-1 degC-4] +real, parameter :: BET050 = 0.5*EOS150*r1_S0 ! drho_dS fit T**5 coef. [kg m-3 ppt-1 degC-5] +real, parameter :: BET001 = 0.5*EOS101*r1_S0 ! drho_dS fit P coef. [kg m-3 ppt-1 Pa-1] +real, parameter :: BET101 = EOS201*r1_S0 ! drho_dS fit zs * P coef. [kg m-3 ppt-1 Pa-1] +real, parameter :: BET201 = 1.5*EOS301*r1_S0 ! drho_dS fit zs**2 * P coef. [kg m-3 ppt-1 Pa-1] +real, parameter :: BET301 = 2.0*EOS401*r1_S0 ! drho_dS fit zs**3 * P coef. [kg m-3 ppt-1 Pa-1] +real, parameter :: BET011 = 0.5*EOS111*r1_S0 ! drho_dS fit T * P coef. [kg m-3 ppt-1 degC-1 Pa-1] +real, parameter :: BET111 = EOS211*r1_S0 ! drho_dS fit zs * T * P coef. [kg m-3 ppt-1 degC-1 Pa-1] +real, parameter :: BET211 = 1.5*EOS311*r1_S0 ! drho_dS fit zs**2 * T * P coef. [kg m-3 ppt-1 degC-1 Pa-1] +real, parameter :: BET021 = 0.5*EOS121*r1_S0 ! drho_dS fit T**2 * P coef. [kg m-3 ppt-1 degC-2 Pa-1] +real, parameter :: BET121 = EOS221*r1_S0 ! drho_dS fit zs * T**2 * P coef. [kg m-3 ppt-1 degC-2 Pa-1] +real, parameter :: BET031 = 0.5*EOS131*r1_S0 ! drho_dS fit T**3 * P coef. [kg m-3 ppt-1 degC-3 Pa-1] +real, parameter :: BET002 = 0.5*EOS102*r1_S0 ! drho_dS fit P**2 coef. [kg m-3 ppt-1 Pa-2] +real, parameter :: BET102 = EOS202*r1_S0 ! drho_dS fit zs * P**2 coef. [kg m-3 ppt-1 Pa-2] +real, parameter :: BET012 = 0.5*EOS112*r1_S0 ! drho_dS fit T * P**2 coef. [kg m-3 ppt-1 degC-1 Pa-2] +real, parameter :: BET003 = 0.5*EOS103*r1_S0 ! drho_dS fit P**3 coef. [kg m-3 ppt-1 Pa-3] +!>@} + +contains + +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from absolute salinity (S [g kg-1]), conservative temperature (T [degC]) +!! and pressure [Pa], using the density polynomial fit EOS from Roquet et al. (2015). +subroutine calculate_density_scalar_Roquet_rho(T, S, pres, rho, rho_ref) + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] + real, intent(in) :: pres !< Pressure [Pa] + real, intent(out) :: rho !< In situ density [kg m-3] + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pres0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] + + T0(1) = T + S0(1) = S + pres0(1) = pres + + call calculate_density_array_Roquet_rho(T0, S0, pres0, rho0, 1, 1, rho_ref) + rho = rho0(1) + +end subroutine calculate_density_scalar_Roquet_rho + +!> This subroutine computes an array of in situ densities of sea water (rho in [kg m-3]) +!! from absolute salinity (S [g kg-1]), conservative temperature (T [degC]), and pressure +!! [Pa], using the density polynomial fit EOS from Roquet et al. (2015). +subroutine calculate_density_array_Roquet_rho(T, S, pres, rho, start, npts, rho_ref) + real, dimension(:), intent(in) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in) :: S !< Absolute salinity [g kg-1] + real, dimension(:), intent(in) :: pres !< Pressure [Pa] + real, dimension(:), intent(out) :: rho !< In situ density [kg m-3] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: rho00p ! A pressure-dependent but temperature and salinity independent contribution to + ! density at the reference temperature and salinity [kg m-3] + real :: rhoTS ! Density without a pressure-dependent contribution [kg m-3] + real :: rhoTS0 ! A contribution to density from temperature and salinity anomalies at the + ! surface pressure [kg m-3] + real :: rhoTS1 ! A density contribution proportional to pressure [kg m-3 Pa-1] + real :: rhoTS2 ! A density contribution proportional to pressure**2 [kg m-3 Pa-2] + real :: rhoTS3 ! A density contribution proportional to pressure**3 [kg m-3 Pa-3] + real :: rho0S0 ! Salinity dependent density at the surface pressure and zero temperature [kg m-3] + integer :: j + + ! The following algorithm was published by Roquet et al. (2015), intended for use with NEMO. + do j=start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = pres(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + rhoTS3 = EOS003 + (zs*EOS103 + zt*EOS013) + rhoTS2 = EOS002 + (zs*(EOS102 + zs*EOS202) & + + zt*(EOS012 + (zs*EOS112 + zt*EOS022)) ) + rhoTS1 = EOS001 + (zs*(EOS101 + zs*(EOS201 + zs*(EOS301 + zs*EOS401))) & + + zt*(EOS011 + (zs*(EOS111 + zs*(EOS211 + zs*EOS311)) & + + zt*(EOS021 + (zs*(EOS121 + zs*EOS221) & + + zt*(EOS031 + (zs*EOS131 + zt*EOS041)) )) )) ) + rhoTS0 = zt*(EOS010 & + + (zs*(EOS110 + zs*(EOS210 + zs*(EOS310 + zs*(EOS410 + zs*EOS510)))) & + + zt*(EOS020 + (zs*(EOS120 + zs*(EOS220 + zs*(EOS320 + zs*EOS420))) & + + zt*(EOS030 + (zs*(EOS130 + zs*(EOS230 + zs*EOS330)) & + + zt*(EOS040 + (zs*(EOS140 + zs*EOS240) & + + zt*(EOS050 + (zs*EOS150 + zt*EOS060)) )) )) )) ) ) + + rho0S0 = EOS000 + zs*(EOS100 + zs*(EOS200 + zs*(EOS300 + zs*(EOS400 + zs*(EOS500 + zs*EOS600))))) + + rho00p = zp*(R00 + zp*(R01 + zp*(R02 + zp*(R03 + zp*(R04 + zp*R05))))) + + if (present(rho_ref)) rho0S0 = rho0S0 - rho_ref + + rhoTS = (rhoTS0 + rho0S0) + zp*(rhoTS1 + zp*(rhoTS2 + zp*rhoTS3)) + rho(j) = rhoTS + rho00p ! In situ density [kg m-3] + + enddo +end subroutine calculate_density_array_Roquet_rho + +!> For a given thermodynamic state, calculate the derivatives of density with conservative +!! temperature and absolute salinity, using the density polynomial fit EOS from Roquet et al. (2015). +subroutine calculate_density_derivs_array_Roquet_rho(T, S, pres, drho_dT, drho_dS, start, npts) + real, intent(in), dimension(:) :: T !< Conservative temperature [degC] + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1] + real, intent(in), dimension(:) :: pres !< Pressure [Pa] + real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with + !! conservative temperature [kg m-3 degC-1] + real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with + !! absolute salinity [kg m-3 ppt-1] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: dRdzt0 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] + ! from temperature anomalies at the surface pressure + real :: dRdzt1 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1 Pa-1] + ! proportional to pressure + real :: dRdzt2 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1 Pa-2] + ! proportional to pressure**2 + real :: dRdzt3 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1 Pa-3] + ! proportional to pressure**3 + real :: dRdzs0 ! A contribution to the partial derivative of density with + ! salinity [kg m-3 ppt-1] from temperature anomalies at the surface pressure + real :: dRdzs1 ! A contribution to the partial derivative of density with + ! salinity [kg m-3 ppt-1 Pa-1] proportional to pressure + real :: dRdzs2 ! A contribution to the partial derivative of density with + ! salinity [kg m-3 ppt-1 Pa-2] proportional to pressure**2 + real :: dRdzs3 ! A contribution to the partial derivative of density with + ! salinity [kg m-3 ppt-1 Pa-3] proportional to pressure**3 + integer :: j + + do j=start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = pres(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + ! Find the partial derivative of density with temperature + dRdzt3 = ALP003 + dRdzt2 = ALP002 + (zs*ALP102 + zt*ALP012) + dRdzt1 = ALP001 + (zs*(ALP101 + zs*(ALP201 + zs*ALP301)) & + + zt*(ALP011 + (zs*(ALP111 + zs*ALP211) & + + zt*(ALP021 + (zs*ALP121 + zt*ALP031)) )) ) + dRdzt0 = ALP000 + (zs*(ALP100 + zs*(ALP200 + zs*(ALP300 + zs*(ALP400 + zs*ALP500)))) & + + zt*(ALP010 + (zs*(ALP110 + zs*(ALP210 + zs*(ALP310 + zs*ALP410))) & + + zt*(ALP020 + (zs*(ALP120 + zs*(ALP220 + zs*ALP320)) & + + zt*(ALP030 + (zt*(ALP040 + (zs*ALP140 + zt*ALP050)) & + + zs*(ALP130 + zs*ALP230) )) )) )) ) + + drho_dT(j) = dRdzt0 + zp*(dRdzt1 + zp*(dRdzt2 + zp*dRdzt3)) + + ! Find the partial derivative of density with salinity + dRdzs3 = BET003 + dRdzs2 = BET002 + (zs*BET102 + zt*BET012) + dRdzs1 = BET001 + (zs*(BET101 + zs*(BET201 + zs*BET301)) & + + zt*(BET011 + (zs*(BET111 + zs*BET211) & + + zt*(BET021 + (zs*BET121 + zt*BET031)) )) ) + dRdzs0 = BET000 + (zs*(BET100 + zs*(BET200 + zs*(BET300 + zs*(BET400 + zs*BET500)))) & + + zt*(BET010 + (zs*(BET110 + zs*(BET210 + zs*(BET310 + zs*BET410))) & + + zt*(BET020 + (zs*(BET120 + zs*(BET220 + zs*BET320)) & + + zt*(BET030 + (zt*(BET040 + (zs*BET140 + zt*BET050)) & + + zs*(BET130 + zs*BET230) )) )) )) ) + + ! The division by zs here is because zs = sqrt(S + S0), so drho_dS = dzs_dS * drho_dzs = (0.5 / zs) * drho_dzs + drho_dS(j) = (dRdzs0 + zp*(dRdzs1 + zp*(dRdzs2 + zp * dRdzs3))) / zs + enddo + +end subroutine calculate_density_derivs_array_Roquet_rho + +!> Wrapper to calculate_density_derivs_array for scalar inputs +subroutine calculate_density_derivs_scalar_Roquet_rho(T, S, pres, drho_dt, drho_ds) + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] + real, intent(in) :: pres !< Pressure [Pa] + real, intent(out) :: drho_dT !< The partial derivative of density with + !! conservative temperature [kg m-3 degC-1] + real, intent(out) :: drho_dS !< The partial derivative of density with + !! absolute salinity [kg m-3 ppt-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pres0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! A 1-d array with a copy of the derivative of density + ! with conservative temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! A 1-d array with a copy of the derivative of density + ! with absolute salinity [kg m-3 ppt-1] + + T0(1) = T + S0(1) = S + pres0(1) = pres + + call calculate_density_derivs_array_Roquet_rho(T0, S0, pres0, drdt0, drds0, 1, 1) + drho_dt = drdt0(1) + drho_ds = drds0(1) +end subroutine calculate_density_derivs_scalar_Roquet_rho + +!> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility +!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), +!! conservative temperature (T [degC]), and pressure [Pa], using the density polynomial +!! fit EOS from Roquet et al. (2015). +subroutine calculate_compress_Roquet_rho(T, S, pres, rho, drho_dp, start, npts) + real, intent(in), dimension(:) :: T !< Conservative temperature [degC] + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1] + real, intent(in), dimension(:) :: pres !< Pressure [Pa] + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3] + real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! [s2 m-2] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: drho00p_dp ! Derivative of the pressure-dependent reference density profile with pressure [kg m-3 Pa-1] + real :: drhoTS_dp ! Derivative of the density anomaly from the reference profile with pressure [kg m-3 Pa-1] + real :: rho00p ! The pressure-dependent (but temperature and salinity independent) reference + ! density profile [kg m-3] + real :: rhoTS ! Density anomaly from the reference profile [kg m-3] + real :: rhoTS0 ! A contribution to density from temperature and salinity anomalies at the + ! surface pressure [kg m-3] + real :: rhoTS1 ! A density contribution proportional to pressure [kg m-3 Pa-1] + real :: rhoTS2 ! A density contribution proportional to pressure**2 [kg m-3 Pa-2] + real :: rhoTS3 ! A density contribution proportional to pressure**3 [kg m-3 Pa-3] + real :: rho0S0 ! Salinity dependent density at the surface pressure and zero temperature [kg m-3] + integer :: j + + ! The following algorithm was published by Roquet et al. (2015), intended for use with NEMO. + do j=start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = pres(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + rhoTS3 = EOS003 + (zs*EOS103 + zt*EOS013) + rhoTS2 = EOS002 + (zs*(EOS102 + zs*EOS202) & + + zt*(EOS012 + (zs*EOS112 + zt*EOS022)) ) + rhoTS1 = EOS001 + (zs*(EOS101 + zs*(EOS201 + zs*(EOS301 + zs*EOS401))) & + + zt*(EOS011 + (zs*(EOS111 + zs*(EOS211 + zs*EOS311)) & + + zt*(EOS021 + (zs*(EOS121 + zs*EOS221) & + + zt*(EOS031 + (zs*EOS131 + zt*EOS041)) )) )) ) + + rhoTS0 = zt*(EOS010 & + + (zs*(EOS110 + zs*(EOS210 + zs*(EOS310 + zs*(EOS410 + zs*EOS510)))) & + + zt*(EOS020 + (zs*(EOS120 + zs*(EOS220 + zs*(EOS320 + zs*EOS420))) & + + zt*(EOS030 + (zs*(EOS130 + zs*(EOS230 + zs*EOS330)) & + + zt*(EOS040 + (zs*(EOS140 + zs*EOS240) & + + zt*(EOS050 + (zs*EOS150 + zt*EOS060)) )) )) )) ) ) + + rho0S0 = EOS000 + zs*(EOS100 + zs*(EOS200 + zs*(EOS300 + zs*(EOS400 + zs*(EOS500 + zs*EOS600))))) + + rho00p = zp*(R00 + zp*(R01 + zp*(R02 + zp*(R03 + zp*(R04 + zp*R05))))) + + rhoTS = (rhoTS0 + rho0S0) + zp*(rhoTS1 + zp*(rhoTS2 + zp*rhoTS3)) + rho(j) = rhoTS + rho00p ! In situ density [kg m-3] + + drho00p_dp = R00 + zp*(2.*R01 + zp*(3.*R02 + zp*(4.*R03 + zp*(5.*R04 + zp*(6.*R05))))) + drhoTS_dp = rhoTS1 + zp*(2.*rhoTS2 + zp*(3.*rhoTS3)) + drho_dp(j) = drhoTS_dp + drho00p_dp ! Compressibility [s2 m-2] + + enddo +end subroutine calculate_compress_Roquet_rho + + +!> Second derivatives of density with respect to temperature, salinity, and pressure for 1-d array +!! inputs and outputs. +subroutine calculate_density_second_derivs_array_Roquet_rho(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in ) :: S !< Absolute salinity [g kg-1] = [ppt] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Second derivative of density with respect + !! to salinity [kg m-3 ppt-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Second derivative of density with respect + !! to salinity and temperature [kg m-3 ppt-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Second derivative of density with respect + !! to temperature [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Second derivative of density with respect to pressure + !! and salinity [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Second derivative of density with respect to pressure + !! and temperature [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< The starting index for calculations + integer, intent(in ) :: npts !< The number of values to calculate + + ! Local variables + real :: zp ! Pressure [Pa] + real :: zt ! Conservative temperature [degC] + real :: zs ! The square root of absolute salinity with an offset normalized + ! by an assumed salinity range [nondim] + real :: I_s ! The inverse of zs [nondim] + real :: d2R_p0 ! A contribution to one of the second derivatives that is independent of pressure [various] + real :: d2R_p1 ! A contribution to one of the second derivatives that is proportional to pressure [various] + real :: d2R_p2 ! A contribution to one of the second derivatives that is proportional to pressure**2 [various] + real :: d2R_p3 ! A contribution to one of the second derivatives that is proportional to pressure**3 [various] + integer :: j + + do j = start,start+npts-1 + ! Conversions to the units used here. + zt = T(j) + zs = SQRT( ABS( S(j) + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] + zp = P(j) + + ! The next two lines should be used if it is necessary to convert potential temperature and + ! practical salinity to conservative temperature and absolute salinity. + ! zt = gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + ! zs = SQRT( ABS( gsw_sr_from_sp(S(j)) + rdeltaS ) * r1_S0 ) ! Convert S from practical to absolute salinity. + + I_s = 1.0 / zs + + ! Find drho_ds_ds + d2R_p3 = -EOS103*I_s**2 + d2R_p2 = -(EOS102 + zt*EOS112)*I_s**2 + d2R_p1 = (3.*EOS301 + (zt*(3.*EOS311) + zs*(8.*EOS401))) & + - ( EOS101 + zt*(EOS111 + zt*(EOS121 + zt*EOS131)) )*I_s**2 + d2R_p0 = (3.*EOS300 + (zs*(8.*EOS400 + zs*(15.*EOS500 + zs*(24.*EOS600))) & + + zt*(3.*EOS310 + (zs*(8.*EOS410 + zs*(15.*EOS510)) & + + zt*(3.*EOS320 + (zs*(8.*EOS420) + zt*(3.*EOS330))) )) )) & + - (EOS100 + zt*(EOS110 + zt*(EOS120 + zt*(EOS130 + zt*(EOS140 + zt*EOS150)))) )*I_s**2 + drho_dS_dS(j) = (0.5*r1_S0)**2 * ((d2R_p0 + zp*(d2R_p1 + zp*(d2R_p2 + zp*d2R_p3))) * I_s) + + ! Find drho_ds_dt + d2R_p2 = EOS112 + d2R_p1 = EOS111 + (zs*(2.*EOS211 + zs*(3.*EOS311)) & + + zt*(2.*EOS121 + (zs*(4.*EOS221) + zt*(3.*EOS131))) ) + d2R_p0 = EOS110 + (zs*(2.*EOS210 + zs*(3.*EOS310 + zs*(4.*EOS410 + zs*(5.*EOS510)))) & + + zt*(2.*EOS120 + (zs*(4.*EOS220 + zs*(6.*EOS320 + zs*(8.*EOS420))) & + + zt*(3.*EOS130 + (zs*(6.*EOS230 + zs*(9.*EOS330)) & + + zt*(4.*EOS140 + (zs*(8.*EOS240) & + + zt*(5.*EOS150))) )) )) ) + drho_ds_dt(j) = (0.5*r1_S0) * ((d2R_p0 + zp*(d2R_p1 + zp*d2R_p2)) * I_s) + + ! Find drho_dt_dt + d2R_p2 = 2.*EOS022 + d2R_p1 = 2.*EOS021 + (zs*(2.*EOS121 + zs*(2.*EOS221)) & + + zt*(6.*EOS031 + (zs*(6.*EOS131) + zt*(12.*EOS041))) ) + d2R_p0 = 2.*EOS020 + (zs*(2.*EOS120 + zs*( 2.*EOS220 + zs*( 2.*EOS320 + zs * (2.*EOS420)))) & + + zt*(6.*EOS030 + (zs*( 6.*EOS130 + zs*( 6.*EOS230 + zs * (6.*EOS330))) & + + zt*(12.*EOS040 + (zs*(12.*EOS140 + zs *(12.*EOS240)) & + + zt*(20.*EOS050 + (zs*(20.*EOS150) & + + zt*(30.*EOS060) )) )) )) ) + drho_dt_dt(j) = (d2R_p0 + zp*(d2R_p1 + zp*d2R_p2)) + + ! Find drho_ds_dp + d2R_p2 = 3.*EOS103 + d2R_p1 = 2.*EOS102 + (zs*(4.*EOS202) + zt*(2.*EOS112)) + d2R_p0 = EOS101 + (zs*(2.*EOS201 + zs*(3.*EOS301 + zs*(4.*EOS401))) & + + zt*(EOS111 + (zs*(2.*EOS211 + zs*(3.*EOS311)) & + + zt*( EOS121 + (zs*(2.*EOS221) + zt*EOS131)) )) ) + drho_ds_dp(j) = ((d2R_p0 + zp*(d2R_p1 + zp*d2R_p2)) * I_s) * (0.5*r1_S0) + + ! Find drho_dt_dp + d2R_p2 = 3.*EOS013 + d2R_p1 = 2.*EOS012 + (zs*(2.*EOS112) + zt*(4.*EOS022)) + d2R_p0 = EOS011 + (zs*(EOS111 + zs*( EOS211 + zs* EOS311)) & + + zt*(2.*EOS021 + (zs*(2.*EOS121 + zs*(2.*EOS221)) & + + zt*(3.*EOS031 + (zs*(3.*EOS131) + zt*(4.*EOS041))) )) ) + drho_dt_dp(j) = (d2R_p0 + zp*(d2R_p1 + zp*d2R_p2)) + enddo + +end subroutine calculate_density_second_derivs_array_Roquet_rho + +!> Second derivatives of density with respect to temperature, salinity, and pressure for scalar inputs. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_second_derivs_scalar_Roquet_rho(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Conservative temperature [degC] + real, intent(in ) :: S !< Absolute salinity [g kg-1] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Second derivative of density with respect + !! to salinity [kg m-3 ppt-2] + real, intent( out) :: drho_ds_dt !< Second derivative of density with respect + !! to salinity and temperature [kg m-3 ppt-1 degC-1] + real, intent( out) :: drho_dt_dt !< Second derivative of density with respect + !! to temperature [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Second derivative of density with respect to pressure + !! and salinity [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] + real, intent( out) :: drho_dt_dp !< Second derivative of density with respect to pressure + !! and temperature [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [g kg-1] = [ppt] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 ppt-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 ppt-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T + S0(1) = S + P0(1) = P + call calculate_density_second_derivs_array_Roquet_rho(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) + drho_ds_dt = drdsdt(1) + drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) + drho_dt_dp = drdtdp(1) + +end subroutine calculate_density_second_derivs_scalar_Roquet_rho + +!> Return the range of temperatures, salinities and pressures for which the Roquet et al. (2015) +!! expression for in situ density has been fitted to observations. Care should be taken when +!! applying this equation of state outside of its fit range. +subroutine EoS_fit_range_Roquet_rho(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum conservative temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum conservative temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum absolute salinity over which this EoS is fitted [g kg-1] + real, optional, intent(out) :: S_max !< The maximum absolute salinity over which this EoS is fitted [g kg-1] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -6.0 + if (present(T_max)) T_max = 40.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 42.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 1.0e8 + +end subroutine EoS_fit_range_Roquet_rho + +!> \namespace mom_eos_Roquet_rho +!! +!! \section section_EOS_Roquet_rho Roquet_rho equation of state +!! +!! Fabien Roquet and colleagues developed this equation of state using a simple polynomial fit +!! to the TEOS-10 equation of state, for efficiency when used in the NEMO ocean model. Fabien +!! Roquet also graciously provided the MOM6 team with the original code implementing this +!! equation of state, although it has since been modified and extended to have capabilities +!! mirroring those available with other equations of state in MOM6. This particular equation +!! of state is a balance between an accuracy that matches the TEOS-10 density to better than +!! observational uncertainty with a polynomial form that can be evaluated quickly despite having +!! 52 terms. +!! +!! \subsection section_EOS_Roquet_rho_references References +!! +!! Roquet, F., Madec, G., McDougall, T. J., and Barker, P. M., 2015: +!! Accurate polynomial expressions for the density and specific volume +!! of seawater using the TEOS-10 standard. Ocean Modelling, 90:29-43. + +end module MOM_EOS_Roquet_rho diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index 4c7483c068..22faa495b4 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -17,9 +17,8 @@ module MOM_EOS_TEOS10 implicit none ; private public calculate_compress_teos10, calculate_density_teos10, calculate_spec_vol_teos10 -public calculate_density_derivs_teos10 -public calculate_specvol_derivs_teos10 -public calculate_density_second_derivs_teos10 +public calculate_density_derivs_teos10, calculate_specvol_derivs_teos10 +public calculate_density_second_derivs_teos10, EoS_fit_range_teos10 public gsw_sp_from_sr, gsw_pt_from_ct !> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to @@ -369,4 +368,25 @@ subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) enddo end subroutine calculate_compress_teos10 + +!> Return the range of temperatures, salinities and pressures for which the TEOS-10 +!! equation of state has been fitted to observations. Care should be taken when +!! applying this equation of state outside of its fit range. +subroutine EoS_fit_range_teos10(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum conservative temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum conservative temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum absolute salinity over which this EoS is fitted [g kg-1] + real, optional, intent(out) :: S_max !< The maximum absolute salinity over which this EoS is fitted [g kg-1] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -6.0 + if (present(T_max)) T_max = 40.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 42.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 1.0e8 + +end subroutine EoS_fit_range_teos10 + end module MOM_EOS_TEOS10 diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index 59ebb92c7a..984b4a7217 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -3,18 +3,12 @@ module MOM_EOS_UNESCO ! This file is part of MOM6. See LICENSE.md for the license. -!*********************************************************************** -!* The subroutines in this file implement the equation of state for * -!* sea water using the fit to the UNESCO equation of state given by * -!* the expressions from Jackett and McDougall, 1995, J. Atmos. * -!* Ocean. Tech., 12, 381-389. Coded by J. Stephens, 9/99. * -!*********************************************************************** - implicit none ; private public calculate_compress_UNESCO, calculate_density_UNESCO, calculate_spec_vol_UNESCO -public calculate_density_derivs_UNESCO +public calculate_density_derivs_UNESCO, calculate_specvol_derivs_UNESCO public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO +public calculate_density_second_derivs_UNESCO, EoS_fit_range_UNESCO !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to !! a reference density, from salinity [PSU], potential temperature [degC] and pressure [Pa], @@ -30,59 +24,64 @@ module MOM_EOS_UNESCO module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO end interface calculate_spec_vol_UNESCO +!> Compute the second derivatives of density with various combinations of temperature, salinity and +!! pressure, using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +interface calculate_density_second_derivs_UNESCO + module procedure calculate_density_second_derivs_scalar_UNESCO, calculate_density_second_derivs_array_UNESCO +end interface calculate_density_second_derivs_UNESCO + + !>@{ Parameters in the UNESCO equation of state, as published in appendix A3 of Gill, 1982. -! The following constants are used to calculate rho0, the density of seawater at 1 -! atmosphere pressure. The notation is Rab for the contribution to rho0 from T^a*S^b. +! The following constants are used to calculate rho0, the density of seawater at 1 atmosphere pressure. +! The notation is Rab for the contribution to rho0 from S^a*T^b, with 6 used for the 1.5 power. real, parameter :: R00 = 999.842594 ! A coefficient in the fit for rho0 [kg m-3] -real, parameter :: R10 = 6.793952e-2 ! A coefficient in the fit for rho0 [kg m-3 degC-1] -real, parameter :: R20 = -9.095290e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-2] -real, parameter :: R30 = 1.001685e-4 ! A coefficient in the fit for rho0 [kg m-3 degC-3] -real, parameter :: R40 = -1.120083e-6 ! A coefficient in the fit for rho0 [kg m-3 degC-4] -real, parameter :: R50 = 6.536332e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-5] -real, parameter :: R01 = 0.824493 ! A coefficient in the fit for rho0 [kg m-3 PSU-1] +real, parameter :: R01 = 6.793952e-2 ! A coefficient in the fit for rho0 [kg m-3 degC-1] +real, parameter :: R02 = -9.095290e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-2] +real, parameter :: R03 = 1.001685e-4 ! A coefficient in the fit for rho0 [kg m-3 degC-3] +real, parameter :: R04 = -1.120083e-6 ! A coefficient in the fit for rho0 [kg m-3 degC-4] +real, parameter :: R05 = 6.536332e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-5] +real, parameter :: R10 = 0.824493 ! A coefficient in the fit for rho0 [kg m-3 PSU-1] real, parameter :: R11 = -4.0899e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-1 PSU-1] -real, parameter :: R21 = 7.6438e-5 ! A coefficient in the fit for rho0 [kg m-3 degC-2 PSU-1] -real, parameter :: R31 = -8.2467e-7 ! A coefficient in the fit for rho0 [kg m-3 degC-3 PSU-1] -real, parameter :: R41 = 5.3875e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-4 PSU-1] -real, parameter :: R032 = -5.72466e-3 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] -real, parameter :: R132 = 1.0227e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] -real, parameter :: R232 = -1.6546e-6 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] -real, parameter :: R02 = 4.8314e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-2] +real, parameter :: R12 = 7.6438e-5 ! A coefficient in the fit for rho0 [kg m-3 degC-2 PSU-1] +real, parameter :: R13 = -8.2467e-7 ! A coefficient in the fit for rho0 [kg m-3 degC-3 PSU-1] +real, parameter :: R14 = 5.3875e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-4 PSU-1] +real, parameter :: R60 = -5.72466e-3 ! A coefficient in the fit for rho0 [kg m-3 PSU-1.5] +real, parameter :: R61 = 1.0227e-4 ! A coefficient in the fit for rho0 [kg m-3 degC-1 PSU-1.5] +real, parameter :: R62 = -1.6546e-6 ! A coefficient in the fit for rho0 [kg m-3 degC-2 PSU-1.5] +real, parameter :: R20 = 4.8314e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-2] ! The following constants are used to calculate the secant bulk modulus. -! The notation here is Sab for terms proportional to T^a*S^b, -! Spab for terms proportional to p*T^a*S^b, and SP0ab for terms -! proportional to p^2*T^a*S^b. -! Note that these values differ from those in Appendix A of Gill (1982) because the expressions +! The notation here is Sabc for terms proportional to S^a*T^b*P^c, with 6 used for the 1.5 power. +! Note that these values differ from those in Appendix 3 of Gill (1982) because the expressions ! from Jackett and MacDougall (1995) use potential temperature, rather than in situ temperature. -real, parameter :: S00 = 1.965933e4 ! A coefficient in the secant bulk modulus fit [bar] -real, parameter :: S10 = 1.444304e2 ! A coefficient in the secant bulk modulus fit [bar degC-1] -real, parameter :: S20 = -1.706103 ! A coefficient in the secant bulk modulus fit [bar degC-2] -real, parameter :: S30 = 9.648704e-3 ! A coefficient in the secant bulk modulus fit [bar degC-3] -real, parameter :: S40 = -4.190253e-5 ! A coefficient in the secant bulk modulus fit [bar degC-4] -real, parameter :: S01 = 52.84855 ! A coefficient in the secant bulk modulus fit [bar PSU-1] -real, parameter :: S11 = -3.101089e-1 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-1] -real, parameter :: S21 = 6.283263e-3 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-1] -real, parameter :: S31 = -5.084188e-5 ! A coefficient in the secant bulk modulus fit [bar degC-3 PSU-1] -real, parameter :: S032 = 3.886640e-1 ! A coefficient in the secant bulk modulus fit [bar PSU-3/2] -real, parameter :: S132 = 9.085835e-3 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-3/2] -real, parameter :: S232 = -4.619924e-4 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-3/2] - -real, parameter :: Sp00 = 3.186519 ! A coefficient in the secant bulk modulus fit [nondim] -real, parameter :: Sp10 = 2.212276e-2 ! A coefficient in the secant bulk modulus fit [degC-1] -real, parameter :: Sp20 = -2.984642e-4 ! A coefficient in the secant bulk modulus fit [degC-2] -real, parameter :: Sp30 = 1.956415e-6 ! A coefficient in the secant bulk modulus fit [degC-3] -real, parameter :: Sp01 = 6.704388e-3 ! A coefficient in the secant bulk modulus fit [PSU-1] -real, parameter :: Sp11 = -1.847318e-4 ! A coefficient in the secant bulk modulus fit [degC-1 PSU-1] -real, parameter :: Sp21 = 2.059331e-7 ! A coefficient in the secant bulk modulus fit [degC-2 PSU-1] -real, parameter :: Sp032 = 1.480266e-4 ! A coefficient in the secant bulk modulus fit [PSU-3/2] - -real, parameter :: SP000 = 2.102898e-4 ! A coefficient in the secant bulk modulus fit [bar-1] -real, parameter :: SP010 = -1.202016e-5 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1] -real, parameter :: SP020 = 1.394680e-7 ! A coefficient in the secant bulk modulus fit [bar-1 degC-2] -real, parameter :: SP001 = -2.040237e-6 ! A coefficient in the secant bulk modulus fit [bar-1 PSU-1] -real, parameter :: SP011 = 6.128773e-8 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-1] -real, parameter :: SP021 = 6.207323e-10 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-2] +real, parameter :: S000 = 1.965933e4 ! A coefficient in the secant bulk modulus fit [bar] +real, parameter :: S010 = 1.444304e2 ! A coefficient in the secant bulk modulus fit [bar degC-1] +real, parameter :: S020 = -1.706103 ! A coefficient in the secant bulk modulus fit [bar degC-2] +real, parameter :: S030 = 9.648704e-3 ! A coefficient in the secant bulk modulus fit [bar degC-3] +real, parameter :: S040 = -4.190253e-5 ! A coefficient in the secant bulk modulus fit [bar degC-4] +real, parameter :: S100 = 52.84855 ! A coefficient in the secant bulk modulus fit [bar PSU-1] +real, parameter :: S110 = -3.101089e-1 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-1] +real, parameter :: S120 = 6.283263e-3 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-1] +real, parameter :: S130 = -5.084188e-5 ! A coefficient in the secant bulk modulus fit [bar degC-3 PSU-1] +real, parameter :: S600 = 3.886640e-1 ! A coefficient in the secant bulk modulus fit [bar PSU-1.5] +real, parameter :: S610 = 9.085835e-3 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-1.5] +real, parameter :: S620 = -4.619924e-4 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-1.5] + +real, parameter :: S001 = 3.186519 ! A coefficient in the secant bulk modulus fit [nondim] +real, parameter :: S011 = 2.212276e-2 ! A coefficient in the secant bulk modulus fit [degC-1] +real, parameter :: S021 = -2.984642e-4 ! A coefficient in the secant bulk modulus fit [degC-2] +real, parameter :: S031 = 1.956415e-6 ! A coefficient in the secant bulk modulus fit [degC-3] +real, parameter :: S101 = 6.704388e-3 ! A coefficient in the secant bulk modulus fit [PSU-1] +real, parameter :: S111 = -1.847318e-4 ! A coefficient in the secant bulk modulus fit [degC-1 PSU-1] +real, parameter :: S121 = 2.059331e-7 ! A coefficient in the secant bulk modulus fit [degC-2 PSU-1] +real, parameter :: S601 = 1.480266e-4 ! A coefficient in the secant bulk modulus fit [PSU-1.5] + +real, parameter :: S002 = 2.102898e-4 ! A coefficient in the secant bulk modulus fit [bar-1] +real, parameter :: S012 = -1.202016e-5 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1] +real, parameter :: S022 = 1.394680e-7 ! A coefficient in the secant bulk modulus fit [bar-1 degC-2] +real, parameter :: S102 = -2.040237e-6 ! A coefficient in the secant bulk modulus fit [bar-1 PSU-1] +real, parameter :: S112 = 6.128773e-8 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-1] +real, parameter :: S122 = 6.207323e-10 ! A coefficient in the secant bulk modulus fit [bar-1 degC-2 PSU-1] !>@} contains @@ -92,11 +91,11 @@ module MOM_EOS_UNESCO !! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If rho_ref is present, rho is an anomaly from rho_ref. subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) - real, intent(in) :: T !< Potential temperature relative to the surface [degC]. - real, intent(in) :: S !< Salinity [PSU]. - real, intent(in) :: pressure !< pressure [Pa]. - real, intent(out) :: rho !< In situ density [kg m-3]. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + real, intent(in) :: T !< Potential temperature relative to the surface [degC] + real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: rho !< In situ density [kg m-3] + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] ! Local variables real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] @@ -118,51 +117,42 @@ end subroutine calculate_density_scalar_UNESCO !! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If rho_ref is present, rho is an anomaly from rho_ref. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. - real, dimension(:), intent(in) :: S !< salinity [PSU]. - real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. - integer, intent(in) :: start !< the starting point in the arrays. - integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [PSU] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: rho !< In situ density [kg m-3] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] ! Local variables - real :: t_local ! A copy of the temperature at a point [degC] - real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] - real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] - real :: s_local ! A copy of the salinity at a point [PSU] - real :: s32 ! The square root of salinity cubed [PSU3/2] - real :: s2 ! Salinity squared [PSU2]. - real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. - real :: rho0 ! Density at 1 bar pressure [kg m-3]. - real :: sig0 ! The anomaly of rho0 from R00 [kg m-3]. - real :: ks ! The secant bulk modulus [bar]. + real :: t1 ! A copy of the temperature at a point [degC] + real :: s1 ! A copy of the salinity at a point [PSU] + real :: p1 ! Pressure converted to bars [bar] + real :: s12 ! The square root of salinity [PSU1/2] + real :: rho0 ! Density at 1 bar pressure [kg m-3] + real :: sig0 ! The anomaly of rho0 from R00 [kg m-3] + real :: ks ! The secant bulk modulus [bar] integer :: j do j=start,start+npts-1 - if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? - rho(j) = 1000.0 - cycle - endif - - p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 - t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 - s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; t1 = T(j) + s1 = max(S(j), 0.0) ; s12 = sqrt(s1) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). - sig0 = R10*t_local + R20*t2 + R30*t3 + R40*t4 + R50*t5 + & - s_local*(R01 + R11*t_local + R21*t2 + R31*t3 + R41*t4) + & - s32*(R032 + R132*t_local + R232*t2) + R02*s2 + sig0 = ( t1*(R01 + t1*(R02 + t1*(R03 + t1*(R04 + t1*R05)))) + & + s1*((R10 + t1*(R11 + t1*(R12 + t1*(R13 + t1*R14)))) + & + (s12*(R60 + t1*(R61 + t1*R62)) + s1*R20)) ) rho0 = R00 + sig0 ! Compute rho(s,theta,p), first calculating the secant bulk modulus. - ks = S00 + S10*t_local + S20*t2 + S30*t3 + S40*t4 + s_local*(S01 + S11*t_local + S21*t2 + S31*t3) + & - s32*(S032 + S132*t_local + S232*t2) + & - p1*(Sp00 + Sp10*t_local + Sp20*t2 + Sp30*t3 + & - s_local*(Sp01 + Sp11*t_local + Sp21*t2) + Sp032*s32) + & - p2*(SP000 + SP010*t_local + SP020*t2 + s_local*(SP001 + SP011*t_local + SP021*t2)) + ks = (S000 + ( t1*(S010 + t1*(S020 + t1*(S030 + t1*S040))) + & + s1*((S100 + t1*(S110 + t1*(S120 + t1*S130))) + s12*(S600 + t1*(S610 + t1*S620))) )) + & + p1*( (S001 + ( t1*(S011 + t1*(S021 + t1*S031)) + & + s1*((S101 + t1*(S111 + t1*S121)) + s12*S601) )) + & + p1*(S002 + ( t1*(S012 + t1*S022) + s1*(S102 + t1*(S112 + t1*S122)) )) ) if (present(rho_ref)) then rho(j) = ((R00 - rho_ref)*ks + (sig0*ks + p1*rho_ref)) / (ks - p1) @@ -177,12 +167,11 @@ end subroutine calculate_density_array_UNESCO !! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) - real, intent(in) :: T !< potential temperature relative to the surface - !! [degC]. - real, intent(in) :: S !< salinity [PSU]. - real, intent(in) :: pressure !< pressure [Pa]. - real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. - real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + real, intent(in) :: T !< Potential temperature relative to the surface [degC] + real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: specvol !< In situ specific volume [m3 kg-1] + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] ! Local variables real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] @@ -201,51 +190,41 @@ end subroutine calculate_spec_vol_scalar_UNESCO !! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface - !! [degC]. - real, dimension(:), intent(in) :: S !< salinity [PSU]. - real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. - integer, intent(in) :: start !< the starting point in the arrays. - integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [PSU] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: specvol !< In situ specific volume [m3 kg-1] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] ! Local variables - real :: t_local ! A copy of the temperature at a point [degC] - real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] - real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] - real :: s_local ! A copy of the salinity at a point [PSU] - real :: s32 ! The square root of salinity cubed [PSU3/2] - real :: s2 ! Salinity squared [PSU2]. - real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. - real :: rho0 ! Density at 1 bar pressure [kg m-3]. - real :: ks ! The secant bulk modulus [bar]. + real :: t1 ! A copy of the temperature at a point [degC] + real :: s1 ! A copy of the salinity at a point [PSU] + real :: p1 ! Pressure converted to bars [bar] + real :: s12 ! The square root of salinity [PSU1/2]l553 + real :: rho0 ! Density at 1 bar pressure [kg m-3] + real :: ks ! The secant bulk modulus [bar] integer :: j do j=start,start+npts-1 - if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? - specvol(j) = 0.001 - if (present(spv_ref)) specvol(j) = 0.001 - spv_ref - cycle - endif - p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 - t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 - s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; t1 = T(j) + s1 = max(S(j), 0.0) ; s12 = sqrt(s1) -! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). + ! Compute rho(s,theta,p=0), which is the same as rho(s,t_insitu,p=0). - rho0 = R00 + R10*t_local + R20*t2 + R30*t3 + R40*t4 + R50*t5 + & - s_local*(R01 + R11*t_local + R21*t2 + R31*t3 + R41*t4) + & - s32*(R032 + R132*t_local + R232*t2) + R02*s2 + rho0 = R00 + ( t1*(R01 + t1*(R02 + t1*(R03 + t1*(R04 + t1*R05)))) + & + s1*((R10 + t1*(R11 + t1*(R12 + t1*(R13 + t1*R14)))) + & + (s12*(R60 + t1*(R61 + t1*R62)) + s1*R20)) ) -! Compute rho(s,theta,p), first calculating the secant bulk modulus. + ! Compute rho(s,theta,p), first calculating the secant bulk modulus. - ks = S00 + S10*t_local + S20*t2 + S30*t3 + S40*t4 + s_local*(S01 + S11*t_local + S21*t2 + S31*t3) + & - s32*(S032 + S132*t_local + S232*t2) + & - p1*(Sp00 + Sp10*t_local + Sp20*t2 + Sp30*t3 + & - s_local*(Sp01 + Sp11*t_local + Sp21*t2) + Sp032*s32) + & - p2*(SP000 + SP010*t_local + SP020*t2 + s_local*(SP001 + SP011*t_local + SP021*t2)) + ks = (S000 + ( t1*(S010 + t1*(S020 + t1*(S030 + t1*S040))) + & + s1*((S100 + t1*(S110 + t1*(S120 + t1*S130))) + s12*(S600 + t1*(S610 + t1*S620))) )) + & + p1*( (S001 + ( t1*(S011 + t1*(S021 + t1*S031)) + & + s1*((S101 + t1*(S111 + t1*S121)) + s12*S601) )) + & + p1*(S002 + ( t1*(S012 + t1*S022) + s1*(S102 + t1*(S112 + t1*S122)) )) ) if (present(spv_ref)) then specvol(j) = (ks*(1.0 - (rho0*spv_ref)) - p1) / (rho0*ks) @@ -256,144 +235,408 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, end subroutine calculate_spec_vol_array_UNESCO -!> This subroutine calculates the partial derivatives of density -!! with potential temperature and salinity. +!> Calculate the partial derivatives of density with potential temperature and salinity +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! [degC]. - real, intent(in), dimension(:) :: S !< Salinity [PSU]. - real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC] + real, intent(in), dimension(:) :: S !< Salinity [PSU] + real, intent(in), dimension(:) :: pressure !< Pressure [Pa] real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1]. + !! temperature [kg m-3 degC-1] real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 PSU-1]. - integer, intent(in) :: start !< The starting point in the arrays. - integer, intent(in) :: npts !< The number of values to calculate. + !! in [kg m-3 PSU-1] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate ! Local variables - real :: t_local ! A copy of the temperature at a point [degC] - real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] - real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] - real :: s12 ! The square root of salinity [PSU1/2] - real :: s_local ! A copy of the salinity at a point [PSU] - real :: s32 ! The square root of salinity cubed [PSU3/2] - real :: s2 ! Salinity squared [PSU2]. - real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. - real :: rho0 ! Density at 1 bar pressure [kg m-3]. - real :: ks ! The secant bulk modulus [bar]. - real :: drho0_dT ! Derivative of rho0 with T [kg m-3 degC-1]. - real :: drho0_dS ! Derivative of rho0 with S [kg m-3 PSU-1]. - real :: dks_dT ! Derivative of ks with T [bar degC-1]. - real :: dks_dS ! Derivative of ks with S [bar psu-1]. - real :: denom ! 1.0 / (ks - p1) [bar-1]. + real :: t1 ! A copy of the temperature at a point [degC] + real :: s1 ! A copy of the salinity at a point [PSU] + real :: p1 ! Pressure converted to bars [bar] + real :: s12 ! The square root of salinity [PSU1/2] + real :: rho0 ! Density at 1 bar pressure [kg m-3] + real :: ks ! The secant bulk modulus [bar] + real :: drho0_dT ! Derivative of rho0 with T [kg m-3 degC-1] + real :: drho0_dS ! Derivative of rho0 with S [kg m-3 PSU-1] + real :: dks_dT ! Derivative of ks with T [bar degC-1] + real :: dks_dS ! Derivative of ks with S [bar psu-1] + real :: I_denom ! 1.0 / (ks - p1) [bar-1] integer :: j do j=start,start+npts-1 - if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? - drho_dT(j) = 0.0 ; drho_dS(j) = 0.0 - cycle - endif - - p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 - t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 - s_local = S(j) ; s2 = s_local*s_local ; s12 = sqrt(s_local) ; s32 = s_local*s12 - -! compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ) - - rho0 = R00 + R10*t_local + R20*t2 + R30*t3 + R40*t4 + R50*t5 + & - s_local*(R01 + R11*t_local + R21*t2 + R31*t3 + R41*t4) + & - s32*(R032 + R132*t_local + R232*t2) + R02*s2 - drho0_dT = R10 + 2.0*R20*t_local + 3.0*R30*t2 + 4.0*R40*t3 + 5.0*R50*t4 + & - s_local*(R11 + 2.0*R21*t_local + 3.0*R31*t2 + 4.0*R41*t3) + & - s32*(R132 + 2.0*R232*t_local) - drho0_dS = (R01 + R11*t_local + R21*t2 + R31*t3 + R41*t4) + & - 1.5*s12*(R032 + R132*t_local + R232*t2) + 2.0*R02*s_local - -! compute rho(s,theta,p) - - ks = S00 + S10*t_local + S20*t2 + S30*t3 + S40*t4 + s_local*(S01 + S11*t_local + S21*t2 + S31*t3) + & - s32*(S032 + S132*t_local + S232*t2) + & - p1*(Sp00 + Sp10*t_local + Sp20*t2 + Sp30*t3 + & - s_local*(Sp01 + Sp11*t_local + Sp21*t2) + Sp032*s32) + & - p2*(SP000 + SP010*t_local + SP020*t2 + s_local*(SP001 + SP011*t_local + SP021*t2)) - dks_dT = S10 + 2.0*S20*t_local + 3.0*S30*t2 + 4.0*S40*t3 + & - s_local*(S11 + 2.0*S21*t_local + 3.0*S31*t2) + s32*(S132 + 2.0*S232*t_local) + & - p1*(Sp10 + 2.0*Sp20*t_local + 3.0*Sp30*t2 + s_local*(Sp11 + 2.0*Sp21*t_local)) + & - p2*(SP010 + 2.0*SP020*t_local + s_local*(SP011 + 2.0*SP021*t_local)) - dks_dS = (S01 + S11*t_local + S21*t2 + S31*t3) + 1.5*s12*(S032 + S132*t_local + S232*t2) + & - p1*(Sp01 + Sp11*t_local + Sp21*t2 + 1.5*Sp032*s12) + & - p2*(SP001 + SP011*t_local + SP021*t2) - - denom = 1.0 / (ks - p1) - drho_dT(j) = denom*(ks*drho0_dT - rho0*p1*denom*dks_dT) - drho_dS(j) = denom*(ks*drho0_dS - rho0*p1*denom*dks_dS) + p1 = pressure(j)*1.0e-5 ; t1 = T(j) + s1 = max(S(j), 0.0) ; s12 = sqrt(s1) + + ! Compute rho(s,theta,p=0) and its derivatives with temperature and salinity + rho0 = R00 + ( t1*(R01 + t1*(R02 + t1*(R03 + t1*(R04 + t1*R05)))) + & + s1*((R10 + t1*(R11 + t1*(R12 + t1*(R13 + t1*R14)))) + & + (s12*(R60 + t1*(R61 + t1*R62)) + s1*R20)) ) + drho0_dT = R01 + ( t1*(2.0*R02 + t1*(3.0*R03 + t1*(4.0*R04 + t1*(5.0*R05)))) + & + s1*(R11 + (t1*(2.0*R12 + t1*(3.0*R13 + t1*(4.0*R14))) + & + s12*(R61 + t1*(2.0*R62)) )) ) + drho0_dS = R10 + ( t1*(R11 + t1*(R12 + t1*(R13 + t1*R14))) + & + (1.5*(s12*(R60 + t1*(R61 + t1*R62))) + s1*(2.0*R20)) ) + + ! Compute the secant bulk modulus and its derivatives with temperature and salinity + ks = ( S000 + (t1*(S010 + t1*(S020 + t1*(S030 + t1*S040))) + & + s1*((S100 + t1*(S110 + t1*(S120 + t1*S130))) + s12*(S600 + t1*(S610 + t1*S620)))) ) + & + p1*( (S001 + ( t1*(S011 + t1*(S021 + t1*S031)) + & + s1*((S101 + t1*(S111 + t1*S121)) + s12*S601) )) + & + p1*(S002 + ( t1*(S012 + t1*S022) + s1*(S102 + t1*(S112 + t1*S122)) )) ) + dks_dT = ( S010 + (t1*(2.0*S020 + t1*(3.0*S030 + t1*(4.0*S040))) + & + s1*((S110 + t1*(2.0*S120 + t1*(3.0*S130))) + s12*(S610 + t1*(2.0*S620)))) ) + & + p1*(((S011 + t1*(2.0*S021 + t1*(3.0*S031))) + s1*(S111 + t1*(2.0*S121)) ) + & + p1*(S012 + t1*(2.0*S022) + s1*(S112 + t1*(2.0*S122))) ) + dks_dS = ( S100 + (t1*(S110 + t1*(S120 + t1*S130)) + 1.5*(s12*(S600 + t1*(S610 + t1*S620)))) ) + & + p1*((S101 + t1*(S111 + t1*S121) + s12*(1.5*S601)) + & + p1*(S102 + t1*(S112 + t1*S122)) ) + + I_denom = 1.0 / (ks - p1) + drho_dT(j) = (ks*drho0_dT - dks_dT*((rho0*p1)*I_denom)) * I_denom + drho_dS(j) = (ks*drho0_dS - dks_dS*((rho0*p1)*I_denom)) * I_denom enddo end subroutine calculate_density_derivs_UNESCO -!> This subroutine computes the in situ density of sea water (rho) -!! and the compressibility (drho/dp == C_sound^-2) at the given -!! salinity, potential temperature, and pressure. +!> Return the partial derivatives of specific volume with temperature and salinity +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +subroutine calculate_specvol_derivs_UNESCO(T, S, pressure, dSV_dT, dSV_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. + real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! potential temperature [m3 kg-1 degC-1]. + real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! salinity [m3 kg-1 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: t1 ! A copy of the temperature at a point [degC] + real :: s1 ! A copy of the salinity at a point [PSU] + real :: p1 ! Pressure converted to bars [bar] + real :: s12 ! The square root of salinity [PSU1/2] + real :: rho0 ! Density at 1 bar pressure [kg m-3] + real :: ks ! The secant bulk modulus [bar] + real :: drho0_dT ! Derivative of rho0 with T [kg m-3 degC-1] + real :: drho0_dS ! Derivative of rho0 with S [kg m-3 PSU-1] + real :: dks_dT ! Derivative of ks with T [bar degC-1] + real :: dks_dS ! Derivative of ks with S [bar psu-1] + real :: I_denom2 ! 1.0 / (rho0*ks)**2 [m6 kg-2 bar-2] + integer :: j + + do j=start,start+npts-1 + p1 = pressure(j)*1.0e-5 ; t1 = T(j) + s1 = max(S(j), 0.0) ; s12 = sqrt(s1) + + ! Compute rho(s,theta,p=0) and its derivatives with temperature and salinity + rho0 = R00 + ( t1*(R01 + t1*(R02 + t1*(R03 + t1*(R04 + t1*R05)))) + & + s1*((R10 + t1*(R11 + t1*(R12 + t1*(R13 + t1*R14)))) + & + (s12*(R60 + t1*(R61 + t1*R62)) + s1*R20)) ) + drho0_dT = R01 + ( t1*(2.0*R02 + t1*(3.0*R03 + t1*(4.0*R04 + t1*(5.0*R05)))) + & + s1*(R11 + (t1*(2.0*R12 + t1*(3.0*R13 + t1*(4.0*R14))) + & + s12*(R61 + t1*(2.0*R62)) )) ) + drho0_dS = R10 + ( t1*(R11 + t1*(R12 + t1*(R13 + t1*R14))) + & + (1.5*(s12*(R60 + t1*(R61 + t1*R62))) + s1*(2.0*R20)) ) + + ! Compute the secant bulk modulus and its derivatives with temperature and salinity + ks = ( S000 + (t1*(S010 + t1*(S020 + t1*(S030 + t1*S040))) + & + s1*((S100 + t1*(S110 + t1*(S120 + t1*S130))) + s12*(S600 + t1*(S610 + t1*S620)))) ) + & + p1*( (S001 + ( t1*(S011 + t1*(S021 + t1*S031)) + & + s1*((S101 + t1*(S111 + t1*S121)) + s12*S601) )) + & + p1*(S002 + ( t1*(S012 + t1*S022) + s1*(S102 + t1*(S112 + t1*S122)) )) ) + dks_dT = ( S010 + (t1*(2.0*S020 + t1*(3.0*S030 + t1*(4.0*S040))) + & + s1*((S110 + t1*(2.0*S120 + t1*(3.0*S130))) + s12*(S610 + t1*(2.0*S620)))) ) + & + p1*(((S011 + t1*(2.0*S021 + t1*(3.0*S031))) + s1*(S111 + t1*(2.0*S121)) ) + & + p1*(S012 + t1*(2.0*S022) + s1*(S112 + t1*(2.0*S122))) ) + dks_dS = ( S100 + (t1*(S110 + t1*(S120 + t1*S130)) + 1.5*(s12*(S600 + t1*(S610 + t1*S620)))) ) + & + p1*((S101 + t1*(S111 + t1*S121) + s12*(1.5*S601)) + & + p1*(S102 + t1*(S112 + t1*S122)) ) + + ! specvol(j) = (ks - p1) / (rho0*ks) = 1/rho0 - p1/(rho0*ks) + I_denom2 = 1.0 / (rho0*ks)**2 + dSV_dT(j) = ((p1*rho0)*dks_dT + ((p1 - ks)*ks)*drho0_dT) * I_denom2 + dSV_dS(j) = ((p1*rho0)*dks_dS + ((p1 - ks)*ks)*drho0_dS) * I_denom2 + enddo + +end subroutine calculate_specvol_derivs_UNESCO + +!> Compute the in situ density of sea water (rho) and the compressibility (drho/dp == C_sound^-2) +!! at the given salinity, potential temperature and pressure using the UNESCO (1981) +!! equation of state, as refit by Jackett and McDougall (1995). subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! [degC]. - real, intent(in), dimension(:) :: S !< Salinity [PSU]. - real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. - real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. + !! [degC] + real, intent(in), dimension(:) :: S !< Salinity [PSU] + real, intent(in), dimension(:) :: pressure !< Pressure [Pa] + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3] real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! [s2 m-2]. - integer, intent(in) :: start !< The starting point in the arrays. - integer, intent(in) :: npts !< The number of values to calculate. + !! [s2 m-2] + integer, intent(in) :: start !< The starting index for calculations + integer, intent(in) :: npts !< The number of values to calculate ! Local variables - real :: t_local ! A copy of the temperature at a point [degC] - real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] - real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] - real :: s_local ! A copy of the salinity at a point [PSU] - real :: s32 ! The square root of salinity cubed [PSU3/2] - real :: s2 ! Salinity squared [PSU2]. - real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. - real :: rho0 ! Density at 1 bar pressure [kg m-3]. - real :: ks ! The secant bulk modulus [bar]. - real :: ks_0 ! The secant bulk modulus at zero pressure [bar]. - real :: ks_1 ! The derivative of the secant bulk modulus with pressure at zero pressure [nondim]. - real :: ks_2 ! The second derivative of the secant bulk modulus with pressure at zero pressure [nondim]. - real :: dks_dp ! The derivative of the secant bulk modulus - ! with pressure [nondim] + real :: t1 ! A copy of the temperature at a point [degC] + real :: s1 ! A copy of the salinity at a point [PSU] + real :: p1 ! Pressure converted to bars [bar] + real :: s12 ! The square root of salinity [PSU1/2] + real :: rho0 ! Density at 1 bar pressure [kg m-3] + real :: ks ! The secant bulk modulus [bar] + real :: ks_0 ! The secant bulk modulus at zero pressure [bar] + real :: ks_1 ! The linear pressure dependence of the secant bulk modulus at zero pressure [nondim] + real :: ks_2 ! The quadratic pressure dependence of the secant bulk modulus at zero pressure [bar-1] + real :: dks_dp ! The derivative of the secant bulk modulus with pressure [nondim] + real :: I_denom ! 1.0 / (ks - p1) [bar-1] integer :: j do j=start,start+npts-1 - if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? - rho(j) = 1000.0 ; drho_dP(j) = 0.0 - cycle - endif - - p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 - t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 - s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; t1 = T(j) + s1 = max(S(j), 0.0) ; s12 = sqrt(s1) -! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). + ! Compute rho(s,theta,p=0), which is the same as rho(s,t_insitu,p=0). - rho0 = R00 + R10*t_local + R20*t2 + R30*t3 + R40*t4 + R50*t5 + & - s_local*(R01 + R11*t_local + R21*t2 + R31*t3 + R41*t4) + & - s32*(R032 + R132*t_local + R232*t2) + R02*s2 + rho0 = R00 + ( t1*(R01 + t1*(R02 + t1*(R03 + t1*(R04 + t1*R05)))) + & + s1*((R10 + t1*(R11 + t1*(R12 + t1*(R13 + t1*R14)))) + & + (s12*(R60 + t1*(R61 + t1*R62)) + s1*R20)) ) -! Compute rho(s,theta,p), first calculating the secant bulk modulus. - ks_0 = S00 + S10*t_local + S20*t2 + S30*t3 + S40*t4 + & - s_local*(S01 + S11*t_local + S21*t2 + S31*t3) + s32*(S032 + S132*t_local + S232*t2) - ks_1 = Sp00 + Sp10*t_local + Sp20*t2 + Sp30*t3 + & - s_local*(Sp01 + Sp11*t_local + Sp21*t2) + Sp032*s32 - ks_2 = SP000 + SP010*t_local + SP020*t2 + s_local*(SP001 + SP011*t_local + SP021*t2) + ! Calculate the secant bulk modulus and its derivative with pressure. + ks_0 = S000 + ( t1*( S010 + t1*(S020 + t1*(S030 + t1*S040))) + & + s1*((S100 + t1*(S110 + t1*(S120 + t1*S130))) + s12*(S600 + t1*(S610 + t1*S620))) ) + ks_1 = S001 + ( t1*( S011 + t1*(S021 + t1*S031)) + & + s1*((S101 + t1*(S111 + t1*S121)) + s12*S601) ) + ks_2 = S002 + ( t1*( S012 + t1*S022) + s1*(S102 + t1*(S112 + t1*S122)) ) - ks = ks_0 + p1*ks_1 + p2*ks_2 + ks = ks_0 + p1*(ks_1 + p1*ks_2) dks_dp = ks_1 + 2.0*p1*ks_2 + I_denom = 1.0 / (ks - p1) - rho(j) = rho0*ks / (ks - p1) -! The factor of 1.0e-5 is because pressure here is in bars, not Pa. - drho_dp(j) = 1.0e-5 * (rho(j) / (ks - p1)) * (1.0 - dks_dp*p1/ks) + ! Compute the in situ density, rho(s,theta,p), and its derivative with pressure. + rho(j) = rho0*ks * I_denom + ! The factor of 1.0e-5 is because pressure here is in bars, not Pa. + drho_dp(j) = 1.0e-5 * ((rho0 * (ks - p1*dks_dp)) * I_denom**2) enddo end subroutine calculate_compress_UNESCO +!> Calculate second derivatives of density with respect to temperature, salinity, and pressure +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +subroutine calculate_density_second_derivs_array_UNESCO(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] + real, dimension(:), intent(in ) :: S !< Salinity [PSU] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< Starting index in T,S,P + integer, intent(in ) :: npts !< Number of points to loop over + + ! Local variables + real :: t1 ! A copy of the temperature at a point [degC] + real :: s1 ! A copy of the salinity at a point [PSU] + real :: p1 ! Pressure converted to bars [bar] + real :: s12 ! The square root of salinity [PSU1/2] + real :: I_s12 ! The inverse of the square root of salinity [PSU-1/2] + real :: rho0 ! Density at 1 bar pressure [kg m-3] + real :: drho0_dT ! Derivative of rho0 with T [kg m-3 degC-1] + real :: drho0_dS ! Derivative of rho0 with S [kg m-3 PSU-1] + real :: d2rho0_dS2 ! Second derivative of rho0 with salinity [kg m-3 PSU-1] + real :: d2rho0_dSdT ! Second derivative of rho0 with temperature and salinity [kg m-3 degC-1 PSU-1] + real :: d2rho0_dT2 ! Second derivative of rho0 with temperature [kg m-3 degC-2] + real :: ks ! The secant bulk modulus [bar] + real :: ks_0 ! The secant bulk modulus at zero pressure [bar] + real :: ks_1 ! The linear pressure dependence of the secant bulk modulus at zero pressure [nondim] + real :: ks_2 ! The quadratic pressure dependence of the secant bulk modulus at zero pressure [bar-1] + real :: dks_dp ! The derivative of the secant bulk modulus with pressure [nondim] + real :: dks_dT ! Derivative of the secant bulk modulus with temperature [bar degC-1] + real :: dks_dS ! Derivative of the secant bulk modulus with salinity [bar psu-1] + real :: d2ks_dT2 ! Second derivative of the secant bulk modulus with temperature [bar degC-2] + real :: d2ks_dSdT ! Second derivative of the secant bulk modulus with salinity and temperature [bar psu-1 degC-1] + real :: d2ks_dS2 ! Second derivative of the secant bulk modulus with salinity [bar psu-2] + real :: d2ks_dSdp ! Second derivative of the secant bulk modulus with salinity and pressure [psu-1] + real :: d2ks_dTdp ! Second derivative of the secant bulk modulus with temperature and pressure [degC-1] + real :: I_denom ! The inverse of the denominator of the expression for density [bar-1] + integer :: j + + do j=start,start+npts-1 + + p1 = P(j)*1.0e-5 ; t1 = T(j) + s1 = max(S(j), 0.0) ; s12 = sqrt(s1) + ! The UNESCO equation of state is a fit to density, but it chooses a form that exhibits a + ! singularity in the second derivatives with salinity for fresh water. To avoid this, the + ! square root of salinity can be treated with a floor such that the contribution from the + ! S**1.5 terms to both the surface density and the secant bulk modulus are lost to roundoff. + ! This salinity is given by (~1e-16*S000/S600)**(2/3) ~= 3e-8 PSU, or S12 ~= 1.7e-4 + I_s12 = 1.0 / (max(s12, 1.0e-4)) + + ! Calculate the density at sea level pressure and its derivatives + rho0 = R00 + ( t1*(R01 + t1*(R02 + t1*(R03 + t1*(R04 + t1*R05)))) + & + s1*((R10 + t1*(R11 + t1*(R12 + t1*(R13 + t1*R14)))) + & + (s12*(R60 + t1*(R61 + t1*R62)) + s1*R20)) ) + drho0_dT = R01 + ( t1*(2.0*R02 + t1*(3.0*R03 + t1*(4.0*R04 + t1*(5.0*R05)))) + & + s1*(R11 + ( t1*(2.0*R12 + t1*(3.0*R13 + t1*(4.0*R14))) + & + s12*(R61 + t1*(2.0*R62)) ) ) ) + drho0_dS = R10 + ( t1*(R11 + t1*(R12 + t1*(R13 + t1*R14))) + & + (1.5*(s12*(R60 + t1*(R61 + t1*R62))) + s1*(2.0*R20)) ) + d2rho0_dS2 = 0.75*(R60 + t1*(R61 + t1*R62))*I_s12 + 2.0*R20 + d2rho0_dSdT = R11 + ( t1*(2.0*R12 + t1*(3.0*R13 + t1*(4.0*R14))) + s12*(1.5*R61 + t1*(3.0*R62)) ) + d2rho0_dT2 = 2.0*R02 + ( t1*(6.0*R03 + t1*(12.0*R04 + t1*(20.0*R05))) + & + s1*((2.0*R12 + t1*(6.0*R13 + t1*(12.0*R14))) + s12*(2.0*R62)) ) + + ! Calculate the secant bulk modulus and its derivatives + ks_0 = S000 + ( t1*( S010 + t1*(S020 + t1*(S030 + t1*S040))) + & + s1*((S100 + t1*(S110 + t1*(S120 + t1*S130))) + s12*(S600 + t1*(S610 + t1*S620))) ) + ks_1 = S001 + ( t1*( S011 + t1*(S021 + t1*S031)) + & + s1*((S101 + t1*(S111 + t1*S121)) + s12*S601) ) + ks_2 = S002 + ( t1*( S012 + t1*S022) + s1*(S102 + t1*(S112 + t1*S122)) ) + + ks = ks_0 + p1*(ks_1 + p1*ks_2) + dks_dp = ks_1 + 2.0*p1*ks_2 + dks_dT = (S010 + ( t1*(2.0*S020 + t1*(3.0*S030 + t1*(4.0*S040))) + & + s1*((S110 + t1*(2.0*S120 + t1*(3.0*S130))) + s12*(S610 + t1*(2.0*S620))) )) + & + p1*((S011 + t1*(2.0*S021 + t1*(3.0*S031)) + s1*(S111 + t1*(2.0*S121))) + & + p1*(S012 + t1*(2.0*S022) + s1*(S112 + t1*(2.0*S122)))) + dks_dS = (S100 + ( t1*(S110 + t1*(S120 + t1*S130)) + 1.5*(s12*(S600 + t1*(S610 + t1*S620))) )) + & + p1*((S101 + t1*(S111 + t1*S121) + s12*(1.5*S601)) + & + p1*(S102 + t1*(S112 + t1*S122))) + d2ks_dS2 = 0.75*((S600 + t1*(S610 + t1*S620)) + p1*S601)*I_s12 + d2ks_dSdT = (S110 + ( t1*(2.0*S120 + t1*(3.0*S130)) + s12*(1.5*S610 + t1*(3.0*S620)) )) + & + p1*((S111 + t1*(2.0*S121)) + p1*(S112 + t1*(2.0*S122))) + d2ks_dT2 = 2.0*(S020 + ( t1*(3.0*S030 + t1*(6.0*S040)) + s1*((S120 + t1*(3.0*S130)) + s12*S620) )) + & + 2.0*p1*((S021 + (t1*(3.0*S031) + s1*S121)) + p1*(S022 + s1*S122)) + + d2ks_dSdp = (S101 + (t1*(S111 + t1*S121) + s12*(1.5*S601))) + & + 2.0*p1*(S102 + t1*(S112 + t1*S122)) + d2ks_dTdp = (S011 + (t1*(2.0*S021 + t1*(3.0*S031)) + s1*(S111 + t1*(2.0*S121)))) + & + 2.0*p1*(S012 + t1*(2.0*S022) + s1*(S112 + t1*(2.0*S122))) + I_denom = 1.0 / (ks - p1) + + ! Expressions for density and its first derivatives are copied here for reference: + ! rho = rho0*ks * I_denom + ! drho_dT = I_denom*(ks*drho0_dT - p1*rho0*I_denom*dks_dT) + ! drho_dS = I_denom*(ks*drho0_dS - p1*rho0*I_denom*dks_dS) + ! drho_dp = 1.0e-5 * (rho0 * I_denom**2) * (ks - dks_dp*p1) + + ! Finally calculate the second derivatives + drho_dS_dS(j) = I_denom * ( ks*d2rho0_dS2 - (p1*I_denom) * & + (2.0*drho0_dS*dks_dS + rho0*(d2ks_dS2 - 2.0*dks_dS**2*I_denom)) ) + drho_dS_dT(j) = I_denom * (ks * d2rho0_dSdT - (p1*I_denom) * & + ((drho0_dT*dks_dS + drho0_dS*dks_dT) + & + rho0*(d2ks_dSdT - 2.0*(dks_dS*dks_dT)*I_denom)) ) + drho_dT_dT(j) = I_denom * ( ks*d2rho0_dT2 - (p1*I_denom) * & + (2.0*drho0_dT*dks_dT + rho0*(d2ks_dT2 - 2.0*dks_dT**2*I_denom)) ) + + ! The factor of 1.0e-5 is because pressure here is in bars, not Pa. + drho_dS_dp(j) = (1.0e-5 * I_denom**2) * ( (ks*drho0_dS - rho0*dks_dS) - & + p1*( (dks_dp*drho0_dS + rho0*d2ks_dSdp) - & + 2.0*(rho0*dks_dS) * ((dks_dp - 1.0)*I_denom) ) ) + drho_dT_dp(j) = (1.0e-5 * I_denom**2) * ( (ks*drho0_dT - rho0*dks_dT) - & + p1*( (dks_dp*drho0_dT + rho0*d2ks_dTdp) - & + 2.0*(rho0*dks_dT) * ((dks_dp - 1.0)*I_denom) ) ) + enddo + +end subroutine calculate_density_second_derivs_array_UNESCO + +!> Second derivatives of density with respect to temperature, salinity and pressure for scalar inputs +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +!! Inputs are promoted to 1-element arrays and outputs are demoted to scalars. +subroutine calculate_density_second_derivs_scalar_UNESCO(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Potential temperature referenced to 0 dbar + real, intent(in ) :: S !< Salinity [PSU] + real, intent(in ) :: P !< Pressure [Pa] + real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T + S0(1) = S + P0(1) = P + call calculate_density_second_derivs_array_UNESCO(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) + drho_ds_dt = drdsdt(1) + drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) + drho_dt_dp = drdtdp(1) + +end subroutine calculate_density_second_derivs_scalar_UNESCO + +!> Return the range of temperatures, salinities and pressures for which Jackett and McDougall (1995) +!! refit the UNESCO equation of state has been fitted to observations. Care should be taken when +!! applying this equation of state outside of its fit range. +subroutine EoS_fit_range_UNESCO(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: S_max !< The maximum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -2.5 + if (present(T_max)) T_max = 40.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 42.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 1.0e8 + +end subroutine EoS_fit_range_UNESCO + +!> \namespace mom_eos_UNESCO +!! +!! \section section_EOS_UNESCO UNESCO (Jackett & McDougall) equation of state +!! +!! The UNESCO (1981) equation of state is an internationally defined standard fit valid over the +!! range of pressures up to 10000 dbar, temperatures between the freezing point and 40 degC, and +!! salinities between 0 and 42 PSU. Unfortunately, these expressions used in situ temperatures, +!! whereas ocean models (including MOM6) effectively use potential temperatures as their state +!! variables. To avoid needing multiple conversions, Jackett and McDougall (1995) refit the +!! UNESCO equation of state to take potential temperature as a state variable, over the same +!! valid range and functional form as the original UNESCO expressions. It is this refit from +!! Jackett and McDougall (1995) that is coded up in this module. +!! +!! The functional form of the equation of state includes terms proportional to salinity to the +!! 3/2 power. This introduces a singularity in the second derivative of density with salinity +!! at a salinity of 0, but this has been addressed here by setting a floor of 1e-8 PSU on the +!! salinity that is used in the denominator of these second derivative expressions. This value +!! was chosen to imply a contribution that is smaller than numerical roundoff in the expression +!! for density, which is the field for which the UNESCO equation of state was originally derived. +!! +!! Originally coded in 1999 by J. Stephens, revised in 2023 to unambiguously specify the order +!! of arithmetic with parenthesis in every real sum of three or more terms. +!! +!! \subsection section_EOS_UNESCO_references References +!! +!! Gill, A. E., 1982: Atmosphere-Ocean Dynamics. Academic Press, 662 pp. +!! +!! Jackett, D. and T. McDougall, 1995: Minimal adjustment of hydrographic profiles to +!! achieve static stability. J. Atmos. Ocean. Tech., 12, 381-389. +!! +!! UNESCO, 1981: Tenth report of the joint panel on oceanographic tables and standards. +!! UNESCO Technical Papers in Marine Sci. No. 36, UNESCO, Paris. end module MOM_EOS_UNESCO diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 77e0d17ff3..d8dee28aa2 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -3,73 +3,57 @@ module MOM_EOS_Wright ! This file is part of MOM6. See LICENSE.md for the license. -!*********************************************************************** -!* The subroutines in this file implement the equation of state for * -!* sea water using the formulae given by Wright, 1997, J. Atmos. * -!* Ocean. Tech., 14, 735-740. Coded by R. Hallberg, 7/00. * -!*********************************************************************** - use MOM_hor_index, only : hor_index_type implicit none ; private -#include - public calculate_compress_wright, calculate_density_wright, calculate_spec_vol_wright public calculate_density_derivs_wright, calculate_specvol_derivs_wright -public calculate_density_second_derivs_wright +public calculate_density_second_derivs_wright, calc_density_second_derivs_wright_buggy +public EoS_fit_range_Wright, avg_spec_vol_Wright public int_density_dz_wright, int_spec_vol_dp_wright -! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional -! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units -! vary with the Boussinesq approximation, the Boussinesq variant is given first. - - !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to !! a reference density, from salinity in practical salinity units ([PSU]), potential -!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from -!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! temperature (in degrees Celsius [degC]) and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. interface calculate_density_wright module procedure calculate_density_scalar_wright, calculate_density_array_wright end interface calculate_density_wright !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from salinity in practical salinity units ([PSU]), potential -!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from -!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! temperature (in degrees Celsius [degC]) and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. interface calculate_spec_vol_wright module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright end interface calculate_spec_vol_wright -!> For a given thermodynamic state, return the derivatives of density with temperature and salinity +!> Compute the derivatives of density with temperature and salinity interface calculate_density_derivs_wright module procedure calculate_density_derivs_scalar_wright, calculate_density_derivs_array_wright -end interface +end interface calculate_density_derivs_wright -!> For a given thermodynamic state, return the second derivatives of density with various combinations -!! of temperature, salinity, and pressure +!> Compute the second derivatives of density with various combinations +!! of temperature, salinity and pressure, using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. interface calculate_density_second_derivs_wright module procedure calculate_density_second_derivs_scalar_wright, calculate_density_second_derivs_array_wright -end interface +end interface calculate_density_second_derivs_wright -!>@{ Parameters in the Wright equation of state -!real :: a0, a1, a2, b0, b1, b2, b3, b4, b5, c0, c1, c2, c3, c4, c5 -! One of the two following blocks of values should be commented out. -! Following are the values for the full range formula. -! -!real, parameter :: a0 = 7.133718e-4, a1 = 2.724670e-7, a2 = -1.646582e-7 -!real, parameter :: b0 = 5.613770e8, b1 = 3.600337e6, b2 = -3.727194e4 -!real, parameter :: b3 = 1.660557e2, b4 = 6.844158e5, b5 = -8.389457e3 -!real, parameter :: c0 = 1.609893e5, c1 = 8.427815e2, c2 = -6.931554 -!real, parameter :: c3 = 3.869318e-2, c4 = -1.664201e2, c5 = -2.765195 +!> Compute the second derivatives of density with various combinations of temperature, salinity and +!! pressure, but deliberately retaining a bug that reproduces older answers for the second +!! derivative of density with temperature and the second derivative with temperature and pressure +interface calc_density_second_derivs_wright_buggy + module procedure calc_dens_second_derivs_buggy_scalar_wright, calc_dens_second_derivs_buggy_array_wright +end interface calc_density_second_derivs_wright_buggy +!>@{ Parameters in the Wright equation of state using the reduced range formula, which is a fit to the UNESCO +! equation of state for the restricted range: -2 < theta < 30 [degC], 28 < S < 38 [PSU], 0 < p < 5e7 [Pa]. -! Following are the values for the reduced range formula. ! Note that a0/a1 ~= 2028 [degC] ; a0/a2 ~= -6343 [PSU] ! b0/b1 ~= 165 [degC] ; b0/b4 ~= 974 [PSU] ! c0/c1 ~= 216 [degC] ; c0/c4 ~= -740 [PSU] - ! and also that (as always) [Pa] = [kg m-1 s-2] real, parameter :: a0 = 7.057924e-4 ! A parameter in the Wright alpha_0 fit [m3 kg-1] real, parameter :: a1 = 3.480336e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 degC-1] real, parameter :: a2 = -1.112733e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 PSU-1] @@ -89,10 +73,11 @@ module MOM_EOS_Wright contains -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure [Pa]. It uses the expression from -!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!> Computes the in situ density of sea water for scalar inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface [degC]. real, intent(in) :: S !< Salinity [PSU]. @@ -100,14 +85,7 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) real, intent(out) :: rho !< In situ density [kg m-3]. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. -! *====================================================================* -! * This subroutine computes the in situ density of sea water (rho in * -! * [kg m-3]) from salinity (S [PSU]), potential temperature * -! * (T [degC]), and pressure [Pa]. It uses the expression from * -! * Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. * -! * Coded by R. Hallberg, 7/00 * -! *====================================================================* - + ! Local variables real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] @@ -122,10 +100,11 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_wright -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure [Pa]. It uses the expression from -!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!> Computes the in situ density of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. real, dimension(:), intent(in) :: S !< salinity [PSU]. @@ -135,7 +114,6 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - ! Original coded by R. Hallberg, 7/00, anomaly coded in 3/18. ! Local variables real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] real :: p0 ! The pressure offset in the Wright EOS [Pa] @@ -166,10 +144,11 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ end subroutine calculate_density_array_wright -!> This subroutine computes the in situ specific volume of sea water (specvol in -!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure [Pa]. It uses the expression from -!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!> Computes the Wright in situ specific volume of sea water for scalar inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) real, intent(in) :: T !< potential temperature relative to the surface [degC]. @@ -190,10 +169,11 @@ subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) specvol = spv0(1) end subroutine calculate_spec_vol_scalar_wright -!> This subroutine computes the in situ specific volume of sea water (specvol in -!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure [Pa]. It uses the expression from -!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!> Computes the Wright in situ specific volume of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the @@ -224,7 +204,7 @@ subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, enddo end subroutine calculate_spec_vol_array_wright -!> For a given thermodynamic state, return the thermal/haline expansion coefficients +!> Return the thermal/haline expansion coefficients for 1-d array inputs and outputs subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_dS, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the !! surface [degC]. @@ -261,8 +241,10 @@ subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_d end subroutine calculate_density_derivs_array_wright -!> The scalar version of calculate_density_derivs which promotes scalar inputs to a 1-element array and then -!! demotes the output back to a scalar +!> Return the thermal/haline expansion coefficients for scalar inputs and outputs +!! +!! The scalar version of calculate_density_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_dS) real, intent(in) :: T !< Potential temperature relative to the surface [degC]. real, intent(in) :: S !< Salinity [PSU]. @@ -288,7 +270,7 @@ subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_ end subroutine calculate_density_derivs_scalar_wright -!> Second derivatives of density with respect to temperature, salinity, and pressure +!> Second derivatives of density with respect to temperature, salinity and pressure for 1-d array inputs and outputs. subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & drho_ds_dp, drho_dt_dp, start, npts) real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] @@ -319,13 +301,13 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh real :: z2_2 ! A local work variable [m4 s-4] real :: z2_3 ! A local work variable [m6 s-6] integer :: j - ! Based on the above expression with common terms factored, there probably exists a more numerically stable - ! and/or efficient expression + ! See the counterpart in MOM_EOS_Wright_full.F90 for a more numerically stable + ! and/or efficient, but mathematically equivalent expression do j = start,start+npts-1 z0 = T(j)*(b1 + b5*S(j) + T(j)*(b2 + b3*T(j))) z1 = (b0 + P(j) + b4*S(j) + z0) - z3 = (b1 + b5*S(j) + T(j)*(2.*b2 + 2.*b3*T(j))) + z3 = (b1 + b5*S(j) + T(j)*(2.*b2 + 3.*b3*T(j))) z4 = (c0 + c4*S(j) + T(j)*(c1 + c5*S(j) + T(j)*(c2 + c3*T(j)))) z5 = (b1 + b5*S(j) + T(j)*(b2 + b3*T(j)) + T(j)*(b2 + 2.*b3*T(j))) z6 = c1 + c5*S(j) + T(j)*(c2 + c3*T(j)) + T(j)*(c2 + 2.*c3*T(j)) @@ -340,7 +322,7 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh drho_ds_ds(j) = (z10*(c4 + c5*T(j)) - a2*z10*z1 - z10*z7)/z2_2 - (2.*(c4 + c5*T(j) + z9*z10 + a2*z1)*z11)/z2_3 drho_ds_dt(j) = (z10*z6 - z1*(c5 + a2*z5) + b5*z4 - z5*z7)/z2_2 - (2.*(z6 + z9*z5 + a1*z1)*z11)/z2_3 - drho_dt_dt(j) = (z3*z6 - z1*(2.*c2 + 6.*c3*T(j) + a1*z5) + (2.*b2 + 4.*b3*T(j))*z4 - z5*z8)/z2_2 - & + drho_dt_dt(j) = (z3*z6 - z1*(2.*c2 + 6.*c3*T(j) + a1*z5) + (2.*b2 + 6.*b3*T(j))*z4 - z5*z8)/z2_2 - & (2.*(z6 + z9*z5 + a1*z1)*(z3*z4 - z1*z8))/z2_3 drho_ds_dp(j) = (-c4 - c5*T(j) - 2.*a2*z1)/z2_2 - (2.*z9*z11)/z2_3 drho_dt_dp(j) = (-c1 - c5*S(j) - T(j)*(2.*c2 + 3.*c3*T(j)) - 2.*a1*z1)/z2_2 - (2.*z9*(z3*z4 - z1*z8))/z2_3 @@ -348,8 +330,10 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh end subroutine calculate_density_second_derivs_array_wright -!> Second derivatives of density with respect to temperature, salinity, and pressure for scalar inputs. Inputs -!! promoted to 1-element array and output demoted to scalar +!> Second derivatives of density with respect to temperature, salinity and pressure for scalar inputs. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & drho_ds_dp, drho_dt_dp) real, intent(in ) :: T !< Potential temperature referenced to 0 dbar @@ -390,8 +374,116 @@ subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, dr end subroutine calculate_density_second_derivs_scalar_wright -!> For a given thermodynamic state, return the partial derivatives of specific volume -!! with temperature and salinity +!> Second derivatives of density with respect to temperature, salinity and pressure for 1-d array +!! inputs and outputs, but deliberately including a bug to reproduce previous answers, in which +!! some terms in the expressions for drho_dt_dt and drho_dt_dp are 2/3 of what they should be. +subroutine calc_dens_second_derivs_buggy_array_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] + real, dimension(:), intent(in ) :: S !< Salinity [PSU] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< Starting index in T,S,P + integer, intent(in ) :: npts !< Number of points to loop over + + ! Local variables + real :: z0, z1 ! Local work variables [Pa] + real :: z2, z4 ! Local work variables [m2 s-2] + real :: z3, z5 ! Local work variables [Pa degC-1] + real :: z6, z8 ! Local work variables [m2 s-2 degC-1] + real :: z7 ! A local work variable [m2 s-2 PSU-1] + real :: z9 ! A local work variable [m3 kg-1] + real :: z10 ! A local work variable [Pa PSU-1] + real :: z11 ! A local work variable [Pa m2 s-2 PSU-1] = [kg m s-4 PSU-1] + real :: z2_2 ! A local work variable [m4 s-4] + real :: z2_3 ! A local work variable [m6 s-6] + integer :: j + ! Based on the above expression with common terms factored, there probably exists a more numerically stable + ! and/or efficient expression + + do j = start,start+npts-1 + z0 = T(j)*(b1 + b5*S(j) + T(j)*(b2 + b3*T(j))) + z1 = (b0 + P(j) + b4*S(j) + z0) + z3 = (b1 + b5*S(j) + T(j)*(2.*b2 + 2.*b3*T(j))) ! BUG: This should be z3 = b1 + b5*S(j) + T(j)*(2.*b2 + 3.*b3*T(j)) + z4 = (c0 + c4*S(j) + T(j)*(c1 + c5*S(j) + T(j)*(c2 + c3*T(j)))) + z5 = (b1 + b5*S(j) + T(j)*(b2 + b3*T(j)) + T(j)*(b2 + 2.*b3*T(j))) + z6 = c1 + c5*S(j) + T(j)*(c2 + c3*T(j)) + T(j)*(c2 + 2.*c3*T(j)) + z7 = (c4 + c5*T(j) + a2*z1) + z8 = (c1 + c5*S(j) + T(j)*(2.*c2 + 3.*c3*T(j)) + a1*z1) + z9 = (a0 + a2*S(j) + a1*T(j)) + z10 = (b4 + b5*T(j)) + z11 = (z10*z4 - z1*z7) + z2 = (c0 + c4*S(j) + T(j)*(c1 + c5*S(j) + T(j)*(c2 + c3*T(j))) + z9*z1) + z2_2 = z2*z2 + z2_3 = z2_2*z2 + + drho_ds_ds(j) = (z10*(c4 + c5*T(j)) - a2*z10*z1 - z10*z7)/z2_2 - (2.*(c4 + c5*T(j) + z9*z10 + a2*z1)*z11)/z2_3 + drho_ds_dt(j) = (z10*z6 - z1*(c5 + a2*z5) + b5*z4 - z5*z7)/z2_2 - (2.*(z6 + z9*z5 + a1*z1)*z11)/z2_3 + ! BUG: In the following line: (2.*b2 + 4.*b3*T(j)) should be (2.*b2 + 6.*b3*T(j)) + drho_dt_dt(j) = (z3*z6 - z1*(2.*c2 + 6.*c3*T(j) + a1*z5) + (2.*b2 + 4.*b3*T(j))*z4 - z5*z8)/z2_2 - & + (2.*(z6 + z9*z5 + a1*z1)*(z3*z4 - z1*z8))/z2_3 + drho_ds_dp(j) = (-c4 - c5*T(j) - 2.*a2*z1)/z2_2 - (2.*z9*z11)/z2_3 + drho_dt_dp(j) = (-c1 - c5*S(j) - T(j)*(2.*c2 + 3.*c3*T(j)) - 2.*a1*z1)/z2_2 - (2.*z9*(z3*z4 - z1*z8))/z2_3 + enddo + +end subroutine calc_dens_second_derivs_buggy_array_wright + +!> Second derivatives of density with respect to temperature, salinity and pressure for scalar +!! inputs, but deliberately including a bug to reproduce previous answers. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calc_dens_second_derivs_buggy_scalar_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Potential temperature referenced to 0 dbar + real, intent(in ) :: S !< Salinity [PSU] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T + S0(1) = S + P0(1) = P + call calculate_density_second_derivs_array_wright(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) + drho_ds_dt = drdsdt(1) + drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) + drho_dt_dp = drdtdp(1) + +end subroutine calc_dens_second_derivs_buggy_scalar_wright + +!> Return the partial derivatives of specific volume with temperature and salinity +!! for 1-d array inputs and outputs subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. real, intent(in), dimension(:) :: S !< Salinity [PSU]. @@ -425,11 +517,7 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_wright -!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) -!! and the compressibility (drho/dp = C_sound^-2) (drho_dp [s2 m-2]) from -!! salinity (sal [PSU]), potential temperature (T [degC]), and pressure [Pa]. -!! It uses the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. -!! Coded by R. Hallberg, 1/01 +!> Computes the compressibility of seawater for 1-d array inputs and outputs subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. real, intent(in), dimension(:) :: S !< Salinity [PSU]. @@ -441,7 +529,6 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. - ! Coded by R. Hallberg, 1/01 ! Local variables real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] real :: p0 ! The pressure offset in the Wright EOS [Pa] @@ -460,9 +547,67 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) enddo end subroutine calculate_compress_wright -!> This subroutine calculates analytical and nearly-analytical integrals of -!! pressure anomalies across layers, which are required for calculating the -!! finite-volume form pressure accelerations in a Boussinesq model. +!> Calculates analytical and nearly-analytical integrals, in pressure across layers, to determine +!! the layer-average specific volumes. There are essentially no free assumptions, apart from a +!! truncation in the series for log(1-eps/1+eps) that assumes that |eps| < 0.34. +subroutine avg_spec_vol_Wright(T, S, p_t, dp, SpV_avg, start, npts) + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface + !! [degC]. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: p_t !< Pressure at the top of the layer [Pa] + real, dimension(:), intent(in) :: dp !< Pressure change in the layer [Pa] + real, dimension(:), intent(inout) :: SpV_avg !< The vertical average specific volume + !! in the layer [m3 kg-1] + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + + ! Local variables + real :: al0 ! A term in the Wright EOS [m3 kg-1] + real :: p0 ! A term in the Wright EOS [Pa] + real :: lambda ! A term in the Wright EOS [m2 s-2] + real :: eps2 ! The square of a nondimensional ratio [nondim] + real :: I_pterm ! The inverse of p0 plus p_ave [Pa-1]. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0, C1_9 = 1.0/9.0 ! Rational constants [nondim] + integer :: j + + ! alpha(j) = al0 + lambda / (pressure(j) + p0) + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_pterm = 1.0 / (p0 + (p_t(j) + 0.5*dp(j))) + eps2 = (0.5 * dp(j) * I_pterm)**2 + SpV_avg(j) = al0 + (lambda * I_pterm) * & + (1.0 + eps2*(C1_3 + eps2*(0.2 + eps2*(C1_7 + eps2*C1_9)))) + enddo +end subroutine avg_spec_vol_Wright + +!> Return the range of temperatures, salinities and pressures for which the reduced-range equation +!! of state from Wright (1997) has been fitted to observations. Care should be taken when applying +!! this equation of state outside of its fit range. +subroutine EoS_fit_range_Wright(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: S_max !< The maximum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -2.0 + if (present(T_max)) T_max = 30.0 + if (present(S_min)) S_min = 28.0 + if (present(S_max)) S_max = 38.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 5.0e7 + +end subroutine EoS_fit_range_Wright + +!> Calculates analytical and nearly-analytical integrals, in geopotential across layers, of pressure +!! anomalies, which are required for calculating the finite-volume form pressure accelerations in a +!! Boussinesq model. There are essentially no free assumptions, apart from the use of Boole's rule +!! rule to do the horizontal integrals, and from a truncation in the series for log(1-eps/1+eps) +!! that assumes that |eps| < 0.34. subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, & useMassWghtInterp, rho_scale, pres_scale, temp_scale, saln_scale, Z_0p) @@ -718,12 +863,11 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & end subroutine int_density_dz_wright -!> This subroutine calculates analytical and nearly-analytical integrals in -!! pressure across layers of geopotential anomalies, which are required for -!! calculating the finite-volume form pressure accelerations in a non-Boussinesq -!! model. There are essentially no free assumptions, apart from the use of -!! Boole's rule to do the horizontal integrals, and from a truncation in the -!! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. +!> Calculates analytical and nearly-analytical integrals, in pressure across layers, of geopotential +!! anomalies, which are required for calculating the finite-volume form pressure accelerations in a +!! non-Boussinesq model. There are essentially no free assumptions, apart from the use of Boole's +!! rule to do the horizontal integrals, and from a truncation in the series for log(1-eps/1+eps) +!! that assumes that |eps| < 0.34. subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & intp_dza, intx_dza, inty_dza, halo_size, bathyP, dP_neglect, & useMassWghtInterp, SV_scale, pres_scale, temp_scale, saln_scale) @@ -898,7 +1042,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR - ! T, S, and p are interpolated in the horizontal. The p interpolation + ! T, S and p are interpolated in the horizontal. The p interpolation ! is linear, but for T and S it may be thickness weighted. al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) @@ -939,7 +1083,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR - ! T, S, and p are interpolated in the horizontal. The p interpolation + ! T, S and p are interpolated in the horizontal. The p interpolation ! is linear, but for T and S it may be thickness weighted. al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1) p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1) @@ -958,4 +1102,25 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & enddo ; enddo ; endif end subroutine int_spec_vol_dp_wright + +!> \namespace mom_eos_wright +!! +!! \section section_EOS_Wright Wright equation of state +!! +!! Wright, 1997, provide an approximation for the in situ density as a function of +!! potential temperature, salinity and pressure. The formula follow the Tumlirz +!! equation of state which are easier to evaluate and make efficient. +!! +!! Two ranges are provided by Wright: a "full" range and "reduced" range. The version in this +!! module uses the reduced range. +!! +!! Originally coded in 2000 by R. Hallberg. +!! Anomaly form coded in 3/18. +!! +!! \subsection section_EOS_Wright_references References +!! +!! Wright, D., 1997: An Equation of State for Use in Ocean Models: Eckart's Formula Revisited. +!! J. Ocean. Atmosph. Tech., 14 (3), 735-740. +!! https://journals.ametsoc.org/doi/abs/10.1175/1520-0426%281997%29014%3C0735%3AAEOSFU%3E2.0.CO%3B2 + end module MOM_EOS_Wright diff --git a/src/equation_of_state/MOM_EOS_Wright_full.F90 b/src/equation_of_state/MOM_EOS_Wright_full.F90 new file mode 100644 index 0000000000..107ced3f5b --- /dev/null +++ b/src/equation_of_state/MOM_EOS_Wright_full.F90 @@ -0,0 +1,1033 @@ +!> The equation of state using the Wright 1997 expressions +module MOM_EOS_Wright_full + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_hor_index, only : hor_index_type + +implicit none ; private + +public calculate_compress_wright_full, calculate_density_wright_full, calculate_spec_vol_wright_full +public calculate_density_derivs_wright_full, calculate_specvol_derivs_wright_full +public calculate_density_second_derivs_wright_full, EoS_fit_range_Wright_full +public int_density_dz_wright_full, int_spec_vol_dp_wright_full +public avg_spec_vol_Wright_full + +!> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to +!! a reference density, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the full range fit coefficients. +interface calculate_density_wright_full + module procedure calculate_density_scalar_wright, calculate_density_array_wright +end interface calculate_density_wright_full + +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect +!! to a reference specific volume, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the full range fit coefficients. +interface calculate_spec_vol_wright_full + module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright +end interface calculate_spec_vol_wright_full + +!> Compute the derivatives of density with temperature and salinity +interface calculate_density_derivs_wright_full + module procedure calculate_density_derivs_scalar_wright, calculate_density_derivs_array_wright +end interface calculate_density_derivs_wright_full + +!> Compute the second derivatives of density with various combinations +!! of temperature, salinity, and pressure +interface calculate_density_second_derivs_wright_full + module procedure calculate_density_second_derivs_scalar_wright, calculate_density_second_derivs_array_wright +end interface calculate_density_second_derivs_wright_full + +!>@{ Parameters in the Wright equation of state using the full range formula, which is a fit to the UNESCO +! equation of state for the full range: -2 < theta < 40 [degC], 0 < S < 40 [PSU], 0 < p < 1e8 [Pa]. + + ! Note that a0/a1 ~= 2618 [degC] ; a0/a2 ~= -4333 [PSU] + ! b0/b1 ~= 156 [degC] ; b0/b4 ~= 974 [PSU] + ! c0/c1 ~= 216 [degC] ; c0/c4 ~= -741 [PSU] +real, parameter :: a0 = 7.133718e-4 ! A parameter in the Wright alpha_0 fit [m3 kg-1] +real, parameter :: a1 = 2.724670e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 degC-1] +real, parameter :: a2 = -1.646582e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 PSU-1] +real, parameter :: b0 = 5.613770e8 ! A parameter in the Wright p_0 fit [Pa] +real, parameter :: b1 = 3.600337e6 ! A parameter in the Wright p_0 fit [Pa degC-1] +real, parameter :: b2 = -3.727194e4 ! A parameter in the Wright p_0 fit [Pa degC-2] +real, parameter :: b3 = 1.660557e2 ! A parameter in the Wright p_0 fit [Pa degC-3] +real, parameter :: b4 = 6.844158e5 ! A parameter in the Wright p_0 fit [Pa PSU-1] +real, parameter :: b5 = -8.389457e3 ! A parameter in the Wright p_0 fit [Pa degC-1 PSU-1] +real, parameter :: c0 = 1.609893e5 ! A parameter in the Wright lambda fit [m2 s-2] +real, parameter :: c1 = 8.427815e2 ! A parameter in the Wright lambda fit [m2 s-2 degC-1] +real, parameter :: c2 = -6.931554 ! A parameter in the Wright lambda fit [m2 s-2 degC-2] +real, parameter :: c3 = 3.869318e-2 ! A parameter in the Wright lambda fit [m2 s-2 degC-3] +real, parameter :: c4 = -1.664201e2 ! A parameter in the Wright lambda fit [m2 s-2 PSU-1] +real, parameter :: c5 = -2.765195 ! A parameter in the Wright lambda fit [m2 s-2 degC-1 PSU-1] +!>@} + +contains + +!> Computes the in situ density of sea water for scalar inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]), and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the full range fit coefficients. +subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] + + T0(1) = T + S0(1) = S + pressure0(1) = pressure + + call calculate_density_array_wright(T0, S0, pressure0, rho0, 1, 1, rho_ref) + rho = rho0(1) + +end subroutine calculate_density_scalar_wright + +!> Computes the in situ density of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]), and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the full range fit coefficients. +subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ref) + real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(inout) :: rho !< in situ density [kg m-3]. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: al_TS ! The contributions of temperature and salinity to al0 [m3 kg-1] + real :: p_TSp ! A combination of the pressure and the temperature and salinity contributions to p0 [Pa] + real :: lam_TS ! The contributions of temperature and salinity to lambda [m2 s-2] + real :: pa_000 ! A corrected offset to the pressure, including contributions from rho_ref [Pa] + integer :: j + + if (present(rho_ref)) pa_000 = b0*(1.0 - a0*rho_ref) - rho_ref*c0 + if (present(rho_ref)) then ; do j=start,start+npts-1 + al_TS = a1*T(j) + a2*S(j) + al0 = a0 + al_TS + p_TSp = pressure(j) + (b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j)))) + lam_TS = c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) + + ! The following two expressions are mathematically equivalent. + ! rho(j) = (b0 + p0_TSp) / ((c0 + lam_TS) + al0*(b0 + p0_TSp)) - rho_ref + rho(j) = (pa_000 + (p_TSp - rho_ref*(p_TSp*al0 + (b0*al_TS + lam_TS)))) / & + ( (c0 + lam_TS) + al0*(b0 + p_TSp) ) + enddo ; else ; do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + rho(j) = (pressure(j) + p0) / (lambda + al0*(pressure(j) + p0)) + enddo ; endif + +end subroutine calculate_density_array_wright + +!> Computes the Wright in situ specific volume of sea water for scalar inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the full range fit coefficients. +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) + real, intent(in) :: T !< potential temperature relative to the surface [degC]. + real, intent(in) :: S !< salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] + + T0(1) = T ; S0(1) = S ; pressure0(1) = pressure + + call calculate_spec_vol_array_wright(T0, S0, pressure0, spv0, 1, 1, spv_ref) + specvol = spv0(1) +end subroutine calculate_spec_vol_scalar_wright + +!> Computes the Wright in situ specific volume of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the full range fit coefficients. +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, spv_ref) + real, dimension(:), intent(in) :: T !< potential temperature relative to the + !! surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(inout) :: specvol !< in situ specific volume [m3 kg-1]. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2], perhaps with + ! an offset to account for spv_ref + real :: al_TS ! The contributions of temperature and salinity to al0 [m3 kg-1] + real :: p_TSp ! A combination of the pressure and the temperature and salinity contributions to p0 [Pa] + real :: lam_000 ! A corrected offset to lambda, including contributions from spv_ref [m2 s-2] + integer :: j + + if (present(spv_ref)) then + lam_000 = c0 + (a0 - spv_ref)*b0 + do j=start,start+npts-1 + al_TS = a1*T(j) + a2*S(j) + p_TSp = pressure(j) + (b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j)))) + lambda = lam_000 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + ! This is equivalent to the expression below minus spv_ref, but less sensitive to roundoff. + specvol(j) = al_TS + (lambda + (a0 - spv_ref)*p_TSp) / (b0 + p_TSp) + enddo + else + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + specvol(j) = al0 + lambda / (pressure(j) + p0) + enddo + endif +end subroutine calculate_spec_vol_array_wright + +!> Return the thermal/haline expansion coefficients for 1-d array inputs and outputs +subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the + !! surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(inout), dimension(:) :: drho_dT !< The partial derivative of density with potential + !! temperature [kg m-3 degC-1]. + real, intent(inout), dimension(:) :: drho_dS !< The partial derivative of density with salinity, + !! in [kg m-3 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom2 ! The inverse of the square of the denominator of density in the Wright EOS [s4 m-4] + integer :: j + + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_denom2 = 1.0 / (lambda + al0*(pressure(j) + p0))**2 + drho_dT(j) = I_denom2 * (lambda * (b1 + (T(j)*(2.0*b2 + 3.0*b3*T(j)) + b5*S(j))) - & + (pressure(j)+p0) * ( (pressure(j)+p0)*a1 + (c1 + (T(j)*(c2*2.0 + c3*3.0*T(j)) + c5*S(j))) )) + drho_dS(j) = I_denom2 * (lambda * (b4 + b5*T(j)) - & + (pressure(j)+p0) * ( (pressure(j)+p0)*a2 + (c4 + c5*T(j)) )) + enddo + +end subroutine calculate_density_derivs_array_wright + +!> Return the thermal/haline expansion coefficients for scalar inputs and outputs +!! +!! The scalar version of calculate_density_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_dS) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature [kg m-3 degC-1]. + real, intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in [kg m-3 PSU-1]. + + ! Local variables needed to promote the input/output scalars to 1-element arrays + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! The derivative of density with temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! The derivative of density with salinity [kg m-3 PSU-1] + + T0(1) = T + S0(1) = S + P0(1) = pressure + call calculate_density_derivs_array_wright(T0, S0, P0, drdt0, drds0, 1, 1) + drho_dT = drdt0(1) + drho_dS = drds0(1) + +end subroutine calculate_density_derivs_scalar_wright + +!> Second derivatives of density with respect to temperature, salinity, and pressure for 1-d array inputs and outputs. +subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] + real, dimension(:), intent(in ) :: S !< Salinity [PSU] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< Starting index in T,S,P + integer, intent(in ) :: npts !< Number of points to loop over + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: p_p0 ! A local work variable combining the pressure and pressure + ! offset (p0 elsewhere) in the Wright EOS [Pa] + real :: dp0_dT ! The partial derivative of p0 with temperature [Pa degC-1] + real :: dp0_dS ! The partial derivative of p0 with salinity [Pa PSU-1] + real :: dlam_dT ! The partial derivative of lambda with temperature [m2 s-2 degC-1] + real :: dlam_dS ! The partial derivative of lambda with salinity [m2 s-2 degC-1] + real :: dRdT_num ! The numerator in the expression for drho_dT [Pa m2 s-2 degC-1] = [kg m s-4 degC-1] + real :: dRdS_num ! The numerator in the expression for drho_ds [Pa m2 s-2 PSU-1] = [kg m s-4 PSU-1] + real :: ddenom_dT ! The derivative of the denominator of density in the Wright EOS with temperature [m2 s-2 deg-1] + real :: ddenom_dS ! The derivative of the denominator of density in the Wright EOS with salinity [m2 s-2 PSU-1] + real :: I_denom ! The inverse of the denominator of density in the Wright EOS [s2 m-2] + real :: I_denom2 ! The inverse of the square of the denominator of density in the Wright EOS [s4 m-4] + real :: I_denom3 ! The inverse of the cube of the denominator of density in the Wright EOS [s6 m-6] + integer :: j + + do j = start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p_p0 = P(j) + ( b0 + (b4*S(j) + T(j)*(b1 + (b5*S(j) + T(j)*(b2 + b3*T(j))))) ) ! P + p0 + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + dp0_dT = b1 + (b5*S(j) + T(j)*(2.*b2 + 3.*b3*T(j))) + dp0_dS = b4 + b5*T(j) + dlam_dT = c1 + (c5*S(j) + T(j)*(2.*c2 + 3.*c3*T(j))) + dlam_dS = c4 + c5*T(j) + I_denom = 1.0 / (lambda + al0*p_p0) + I_denom2 = I_denom*I_denom + I_denom3 = I_denom*I_denom2 + + ddenom_dS = (dlam_dS + a2*p_p0) + al0*dp0_dS + ddenom_dT = (dlam_dT + a1*p_p0) + al0*dp0_dT + dRdS_num = dp0_dS*lambda - p_p0*(dlam_dS + a2*p_p0) + dRdT_num = dp0_dT*lambda - p_p0*(dlam_dT + a1*p_p0) + + ! In deriving the following, it is useful to note that: + ! rho(j) = p_p0 / (lambda + al0*p_p0) + ! drho_dp(j) = lambda * I_denom2 + ! drho_dT(j) = (dp0_dT*lambda - p_p0*(dlam_dT + a1*p_p0)) * I_denom2 = dRdT_num * I_denom2 + ! drho_dS(j) = (dp0_dS*lambda - p_p0*(dlam_dS + a2*p_p0)) * I_denom2 = dRdS_num * I_denom2 + drho_ds_ds(j) = -2.*(p_p0*(a2*dp0_dS)) * I_denom2 - 2.*(dRdS_num*ddenom_dS) * I_denom3 + drho_ds_dt(j) = ((b5*lambda - p_p0*(c5 + 2.*a2*dp0_dT)) + (dp0_dS*dlam_dT - dp0_dT*dlam_dS))*I_denom2 - & + 2.*(ddenom_dT*dRdS_num) * I_denom3 + drho_dt_dt(j) = 2.*((b2 + 3.*b3*T(j))*lambda - p_p0*((c2 + 3.*c3*T(j)) + a1*dp0_dT))*I_denom2 - & + 2.*(dRdT_num * ddenom_dT) * I_denom3 + + ! The following is a rearranged form that is equivalent to + ! drho_ds_dp(j) = dlam_dS * I_denom2 - 2.0 * lambda * (dlam_dS + a2*p_p0 + al0*dp0_ds) * Idenom3 + drho_ds_dp(j) = (-dlam_dS - 2.*a2*p_p0) * I_denom2 - (2.*al0*dRdS_num) * I_denom3 + drho_dt_dp(j) = (-dlam_dT - 2.*a1*p_p0) * I_denom2 - (2.*al0*dRdT_num) * I_denom3 + enddo + +end subroutine calculate_density_second_derivs_array_wright + +!> Second derivatives of density with respect to temperature, salinity, and pressure for scalar inputs. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Potential temperature referenced to 0 dbar + real, intent(in ) :: S !< Salinity [PSU] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T + S0(1) = S + P0(1) = P + call calculate_density_second_derivs_array_wright(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) + drho_ds_dt = drdsdt(1) + drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) + drho_dt_dp = drdtdp(1) + +end subroutine calculate_density_second_derivs_scalar_wright + +!> Return the partial derivatives of specific volume with temperature and salinity +!! for 1-d array inputs and outputs +subroutine calculate_specvol_derivs_wright_full(T, S, pressure, dSV_dT, dSV_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! potential temperature [m3 kg-1 degC-1]. + real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! salinity [m3 kg-1 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of specific volume in the Wright EOS [Pa-1] + integer :: j + + do j=start,start+npts-1 +! al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + ! SV = al0 + lambda / (pressure(j) + p0) + + I_denom = 1.0 / (pressure(j) + p0) + dSV_dT(j) = a1 + I_denom * ((c1 + (T(j)*(2.0*c2 + 3.0*c3*T(j)) + c5*S(j))) - & + (I_denom * lambda) * (b1 + (T(j)*(2.0*b2 + 3.0*b3*T(j)) + b5*S(j)))) + dSV_dS(j) = a2 + I_denom * ((c4 + c5*T(j)) - & + (I_denom * lambda) * (b4 + b5*T(j))) + enddo + +end subroutine calculate_specvol_derivs_wright_full + +!> Computes the compressibility of seawater for 1-d array inputs and outputs +subroutine calculate_compress_wright_full(T, S, pressure, rho, drho_dp, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(inout), dimension(:) :: rho !< In situ density [kg m-3]. + real, intent(inout), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! [s2 m-2]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of density in the Wright EOS [s2 m-2] + integer :: j + + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_denom = 1.0 / (lambda + al0*(pressure(j) + p0)) + rho(j) = (pressure(j) + p0) * I_denom + drho_dp(j) = lambda * I_denom**2 + enddo +end subroutine calculate_compress_wright_full + +!> Calculates analytical and nearly-analytical integrals, in pressure across layers, to determine +!! the layer-average specific volumes. There are essentially no free assumptions, apart from a +!! truncation in the series for log(1-eps/1+eps) that assumes that |eps| < 0.34. +subroutine avg_spec_vol_Wright_full(T, S, p_t, dp, SpV_avg, start, npts) + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface + !! [degC]. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: p_t !< Pressure at the top of the layer [Pa] + real, dimension(:), intent(in) :: dp !< Pressure change in the layer [Pa] + real, dimension(:), intent(inout) :: SpV_avg !< The vertical average specific volume + !! in the layer [m3 kg-1] + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + + ! Local variables + real :: al0 ! A term in the Wright EOS [m3 kg-1] + real :: p0 ! A term in the Wright EOS [Pa] + real :: lambda ! A term in the Wright EOS [m2 s-2] + real :: eps2 ! The square of a nondimensional ratio [nondim] + real :: I_pterm ! The inverse of p0 plus p_ave [Pa-1]. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0, C1_9 = 1.0/9.0 ! Rational constants [nondim] + integer :: j + + ! alpha(j) = al0 + lambda / (pressure(j) + p0) + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_pterm = 1.0 / (p0 + (p_t(j) + 0.5*dp(j))) + eps2 = (0.5 * dp(j) * I_pterm)**2 + SpV_avg(j) = al0 + (lambda * I_pterm) * & + (1.0 + eps2*(C1_3 + eps2*(0.2 + eps2*(C1_7 + eps2*C1_9)))) + enddo +end subroutine avg_spec_vol_Wright_full + +!> Return the range of temperatures, salinities and pressures for which full-range equation +!! of state from Wright (1997) has been fitted to observations. Care should be taken when applying +!! this equation of state outside of its fit range. +subroutine EoS_fit_range_Wright_full(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: S_max !< The maximum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -2.0 + if (present(T_max)) T_max = 40.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 40.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 1.0e8 + +end subroutine EoS_fit_range_Wright_full + +!> Calculates analytical and nearly-analytical integrals, in geopotential across layers, of pressure +!! anomalies, which are required for calculating the finite-volume form pressure accelerations in a +!! Boussinesq model. There are essentially no free assumptions, apart from the use of Boole's rule +!! rule to do the horizontal integrals, and from a truncation in the series for log(1-eps/1+eps) +!! that assumes that |eps| < 0.34. +subroutine int_density_dz_wright_full(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, & + useMassWghtInterp, rho_scale, pres_scale, temp_scale, saln_scale, Z_0p) + type(hor_index_type), intent(in) :: HI !< The horizontal index type for the arrays. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: T !< Potential temperature relative to the surface + !! [C ~> degC]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: S !< Salinity [S ~> PSU]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted + !! out to reduce the magnitude of each of the integrals. + !! (The pressure is calculated as p~=-z*rho_0*G_e.) + real, intent(in) :: rho_0 !< Density [R ~> kg m-3], that is used + !! to calculate the pressure (as p~=-z*rho_0*G_e) + !! used in the equation of state. + real, intent(in) :: G_e !< The Earth's gravitational acceleration + !! [L2 Z-1 T-2 ~> m s-2]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(inout) :: dpa !< The change in the pressure anomaly across the + !! layer [R L2 T-2 ~> Pa]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer + !! of the pressure anomaly relative to the anomaly + !! at the top of the layer [R Z L2 T-2 ~> Pa m]. + real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & + optional, intent(inout) :: intx_dpa !< The integral in x of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the x grid spacing [R L2 T-2 ~> Pa]. + real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & + optional, intent(inout) :: inty_dpa !< The integral in y of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the y grid spacing [R L2 T-2 ~> Pa]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. + logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to + !! interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: rho_scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1 ~> 1] + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure + !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale + !! temperature into degC [degC C-1 ~> 1] + real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure + !! into PSU [PSU S-1 ~> 1]. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] + + ! Local variables + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [m3 kg-1] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: p0_2d ! A term in the Wright EOS [Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: lambda_2d ! A term in the Wright EOS [m2 s-2] + real :: al0 ! A term in the Wright EOS [m3 kg-1] + real :: p0 ! A term in the Wright EOS [Pa] + real :: lambda ! A term in the Wright EOS [m2 s-2] + real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. + real :: eps, eps2 ! A nondimensional ratio and its square [nondim] + real :: rem ! [kg m-1 s-2] + real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] + real :: g_Earth ! The gravitational acceleration [m2 Z-1 s-2 ~> m s-2] + real :: I_Rho ! The inverse of the Boussinesq density [m3 kg-1] + real :: rho_ref_mks ! The reference density in MKS units [kg m-3] + real :: p_ave ! The layer averaged pressure [Pa] + real :: I_al0 ! The inverse of al0 [kg m-3] + real :: I_Lzz ! The inverse of the denominator [Pa-1] + real :: dz ! The layer thickness [Z ~> m]. + real :: hWght ! A pressure-thickness below topography [Z ~> m]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. + real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa]. + real :: Pa_to_RL2_T2 ! A conversion factor of pressures from Pa to the output units indicated by + ! pres_scale [R L2 T-2 Pa-1 ~> 1]. + real :: z0pres ! The height at which the pressure is zero [Z ~> m] + real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] + real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] + real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] + real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] + real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] + real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] + real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] + logical :: do_massWeight ! Indicates whether to do mass weighting. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m + + ! These array bounds work for the indexing convention of the input arrays, but + ! on the computational domain defined for the output arrays. + Isq = HI%IscB ; Ieq = HI%IecB + Jsq = HI%JscB ; Jeq = HI%JecB + is = HI%isc ; ie = HI%iec + js = HI%jsc ; je = HI%jec + + if (present(pres_scale)) then + GxRho = pres_scale * G_e * rho_0 ; g_Earth = pres_scale * G_e + Pa_to_RL2_T2 = 1.0 / pres_scale + else + GxRho = G_e * rho_0 ; g_Earth = G_e + Pa_to_RL2_T2 = 1.0 + endif + if (present(rho_scale)) then + g_Earth = g_Earth * rho_scale + rho_ref_mks = rho_ref / rho_scale ; I_Rho = rho_scale / rho_0 + else + rho_ref_mks = rho_ref ; I_Rho = 1.0 / rho_0 + endif + z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p + + a1s = a1 ; a2s = a2 + b1s = b1 ; b2s = b2 ; b3s = b3 ; b4s = b4 ; b5s = b5 + c1s = c1 ; c2s = c2 ; c3s = c3 ; c4s = c4 ; c5s = c5 + + if (present(temp_scale)) then ; if (temp_scale /= 1.0) then + a1s = a1s * temp_scale + b1s = b1s * temp_scale ; b2s = b2s * temp_scale**2 + b3s = b3s * temp_scale**3 ; b5s = b5s * temp_scale + c1s = c1s * temp_scale ; c2s = c2s * temp_scale**2 + c3s = c3s * temp_scale**3 ; c5s = c5s * temp_scale + endif ; endif + + if (present(saln_scale)) then ; if (saln_scale /= 1.0) then + a2s = a2s * saln_scale + b4s = b4s * saln_scale ; b5s = b5s * saln_scale + c4s = c4s * saln_scale ; c5s = c5s * saln_scale + endif ; endif + + do_massWeight = .false. + if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then + do_massWeight = .true. + ! if (.not.present(bathyT)) call MOM_error(FATAL, "int_density_dz_generic: "//& + ! "bathyT must be present if useMassWghtInterp is present and true.") + ! if (.not.present(dz_neglect)) call MOM_error(FATAL, "int_density_dz_generic: "//& + ! "dz_neglect must be present if useMassWghtInterp is present and true.") + endif ; endif + + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + al0_2d(i,j) = a0 + (a1s*T(i,j) + a2s*S(i,j)) + p0_2d(i,j) = b0 + ( b4s*S(i,j) + T(i,j) * (b1s + (T(i,j)*(b2s + b3s*T(i,j)) + b5s*S(i,j))) ) + lambda_2d(i,j) = c0 + ( c4s*S(i,j) + T(i,j) * (c1s + (T(i,j)*(c2s + c3s*T(i,j)) + c5s*S(i,j))) ) + + al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) + + dz = z_t(i,j) - z_b(i,j) + p_ave = -GxRho*(0.5*(z_t(i,j)+z_b(i,j)) - z0pres) + + I_al0 = 1.0 / al0 + I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0) + eps = 0.5*(GxRho*dz)*I_Lzz ; eps2 = eps*eps + +! rho(j) = (pressure(j) + p0) / (lambda + al0*(pressure(j) + p0)) + + rho_anom = (p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks + rem = (I_Rho * (lambda * I_al0**2)) * (eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2)))) + dpa(i,j) = Pa_to_RL2_T2 * ((g_Earth*rho_anom)*dz - 2.0*eps*rem) + if (present(intz_dpa)) & + intz_dpa(i,j) = Pa_to_RL2_T2 * (0.5*(g_Earth*rho_anom)*dz**2 - dz*((1.0+eps)*rem)) + enddo ; enddo + + if (present(intx_dpa)) then ; do j=js,je ; do I=Isq,Ieq + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., -bathyT(i,j)-z_t(i+1,j), -bathyT(i+1,j)-z_t(i,j)) + if (hWght > 0.) then + hL = (z_t(i,j) - z_b(i,j)) + dz_neglect + hR = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) + p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) + lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) + + dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j)) + p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i+1,j)+z_b(i+1,j))) - z0pres) + + I_al0 = 1.0 / al0 + I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0) + eps = 0.5*(GxRho*dz)*I_Lzz ; eps2 = eps*eps + + intz(m) = Pa_to_RL2_T2 * ( (g_Earth*dz) * ((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks) - 2.0*eps * & + (I_Rho * (lambda * I_al0**2)) * (eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2)))) ) + enddo + ! Use Boole's rule to integrate the values. + intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3)) + enddo ; enddo ; endif + + if (present(inty_dpa)) then ; do J=Jsq,Jeq ; do i=is,ie + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., -bathyT(i,j)-z_t(i,j+1), -bathyT(i,j+1)-z_t(i,j)) + if (hWght > 0.) then + hL = (z_t(i,j) - z_b(i,j)) + dz_neglect + hR = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i,j+1) + p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i,j+1) + lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i,j+1) + + dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1)) + p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i,j+1)+z_b(i,j+1))) - z0pres) + + I_al0 = 1.0 / al0 + I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0) + eps = 0.5*(GxRho*dz)*I_Lzz ; eps2 = eps*eps + + intz(m) = Pa_to_RL2_T2 * ( (g_Earth*dz) * ((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks) - 2.0*eps * & + (I_Rho * (lambda * I_al0**2)) * (eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2)))) ) + enddo + ! Use Boole's rule to integrate the values. + inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3)) + enddo ; enddo ; endif + +end subroutine int_density_dz_wright_full + +!> Calculates analytical and nearly-analytical integrals, in pressure across layers, of geopotential +!! anomalies, which are required for calculating the finite-volume form pressure accelerations in a +!! non-Boussinesq model. There are essentially no free assumptions, apart from the use of Boole's +!! rule to do the horizontal integrals, and from a truncation in the series for log(1-eps/1+eps) +!! that assumes that |eps| < 0.34. +subroutine int_spec_vol_dp_wright_full(T, S, p_t, p_b, spv_ref, HI, dza, & + intp_dza, intx_dza, inty_dza, halo_size, bathyP, dP_neglect, & + useMassWghtInterp, SV_scale, pres_scale, temp_scale, saln_scale) + type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: T !< Potential temperature relative to the surface + !! [C ~> degC]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: S !< Salinity [S ~> PSU]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] + real, intent(in) :: spv_ref !< A mean specific volume that is subtracted out + !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1]. + !! The calculation is mathematically identical with different values of + !! spv_ref, but this reduces the effects of roundoff. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(inout) :: dza !< The change in the geopotential anomaly across + !! the layer [L2 T-2 ~> m2 s-2]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of + !! the geopotential anomaly relative to the anomaly + !! at the bottom of the layer [R L4 T-4 ~> Pa m2 s-2] + real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & + optional, intent(inout) :: intx_dza !< The integral in x of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the x grid spacing + !! [L2 T-2 ~> m2 s-2]. + real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & + optional, intent(inout) :: inty_dza !< The integral in y of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the y grid spacing + !! [L2 T-2 ~> m2 s-2]. + integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate + !! dza. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] + real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with + !! the same units as p_t [R L2 T-2 ~> Pa] + logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting + !! to interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: SV_scale !< A multiplicative factor by which to scale specific + !! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure + !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale + !! temperature into degC [degC C-1 ~> 1] + real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure + !! into PSU [PSU S-1 ~> 1]. + + ! Local variables + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [R-1 ~> m3 kg-1] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: p0_2d ! A term in the Wright EOS [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: lambda_2d ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] + real :: al0 ! A term in the Wright EOS [R-1 ~> m3 kg-1] + real :: p0 ! A term in the Wright EOS [R L2 T-2 ~> Pa] + real :: lambda ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] + real :: al0_scale ! Scaling factor to convert al0 from MKS units [R-1 kg m-3 ~> 1] + real :: p0_scale ! Scaling factor to convert p0 from MKS units [R L2 T-2 Pa-1 ~> 1] + real :: lam_scale ! Scaling factor to convert lambda from MKS units [L2 s2 T-2 m-2 ~> 1] + real :: p_ave ! The layer average pressure [R L2 T-2 ~> Pa] + real :: rem ! [L2 T-2 ~> m2 s-2] + real :: eps, eps2 ! A nondimensional ratio and its square [nondim] + real :: alpha_anom ! The depth averaged specific volume anomaly [R-1 ~> m3 kg-1]. + real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa]. + real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa]. + real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2]. + real :: I_pterm ! The inverse of p0 plus p_ave [T2 R-1 L-2 ~> Pa-1]. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. + real :: intp(5) ! The integrals of specific volume with pressure at the + ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. + real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] + real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] + real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] + real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] + real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] + real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] + real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] + logical :: do_massWeight ! Indicates whether to do mass weighting. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] + integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, halo + + Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB + halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) + ish = HI%isc-halo ; ieh = HI%iec+halo ; jsh = HI%jsc-halo ; jeh = HI%jec+halo + if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh) ; endif + if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh) ; endif + + + al0_scale = 1.0 ; if (present(SV_scale)) al0_scale = SV_scale + p0_scale = 1.0 + if (present(pres_scale)) then ; if (pres_scale /= 1.0) then + p0_scale = 1.0 / pres_scale + endif ; endif + lam_scale = al0_scale * p0_scale + + a1s = a1 ; a2s = a2 + b1s = b1 ; b2s = b2 ; b3s = b3 ; b4s = b4 ; b5s = b5 + c1s = c1 ; c2s = c2 ; c3s = c3 ; c4s = c4 ; c5s = c5 + + if (present(temp_scale)) then ; if (temp_scale /= 1.0) then + a1s = a1s * temp_scale + b1s = b1s * temp_scale ; b2s = b2s * temp_scale**2 + b3s = b3s * temp_scale**3 ; b5s = b5s * temp_scale + c1s = c1s * temp_scale ; c2s = c2s * temp_scale**2 + c3s = c3s * temp_scale**3 ; c5s = c5s * temp_scale + endif ; endif + + if (present(saln_scale)) then ; if (saln_scale /= 1.0) then + a2s = a2s * saln_scale + b4s = b4s * saln_scale ; b5s = b5s * saln_scale + c4s = c4s * saln_scale ; c5s = c5s * saln_scale + endif ; endif + + do_massWeight = .false. + if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then + do_massWeight = .true. +! if (.not.present(bathyP)) call MOM_error(FATAL, "int_spec_vol_dp_generic: "//& +! "bathyP must be present if useMassWghtInterp is present and true.") +! if (.not.present(dP_neglect)) call MOM_error(FATAL, "int_spec_vol_dp_generic: "//& +! "dP_neglect must be present if useMassWghtInterp is present and true.") + endif ; endif + + ! alpha(j) = (lambda + al0*(pressure(j) + p0)) / (pressure(j) + p0) + do j=jsh,jeh ; do i=ish,ieh + al0_2d(i,j) = al0_scale * ( a0 + (a1s*T(i,j) + a2s*S(i,j)) ) + p0_2d(i,j) = p0_scale * ( b0 + ( b4s*S(i,j) + T(i,j) * (b1s + (T(i,j)*(b2s + b3s*T(i,j)) + b5s*S(i,j))) ) ) + lambda_2d(i,j) = lam_scale * ( c0 + ( c4s*S(i,j) + T(i,j) * (c1s + (T(i,j)*(c2s + c3s*T(i,j)) + c5s*S(i,j))) ) ) + + al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) + dp = p_b(i,j) - p_t(i,j) + p_ave = 0.5*(p_t(i,j)+p_b(i,j)) + I_pterm = 1.0 / (p0 + p_ave) + + eps = 0.5 * dp * I_pterm ; eps2 = eps*eps + alpha_anom = (al0 - spv_ref) + lambda * I_pterm + rem = (lambda * eps2) * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + dza(i,j) = alpha_anom*dp + 2.0*eps*rem + if (present(intp_dza)) & + intp_dza(i,j) = 0.5*alpha_anom*dp**2 - dp*((1.0-eps)*rem) + enddo ; enddo + + if (present(intx_dza)) then ; do j=HI%jsc,HI%jec ; do I=Isq,Ieq + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., bathyP(i,j)-p_t(i+1,j), bathyP(i+1,j)-p_t(i,j)) + if (hWght > 0.) then + hL = (p_b(i,j) - p_t(i,j)) + dP_neglect + hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intp(1) = dza(i,j) ; intp(5) = dza(i+1,j) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + ! T, S, and p are interpolated in the horizontal. The p interpolation + ! is linear, but for T and S it may be thickness weighted. + al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) + p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) + lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) + + dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j)) + p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i+1,j)+p_b(i+1,j))) + I_pterm = 1.0 / (p0 + p_ave) + + eps = 0.5 * dp * I_pterm ; eps2 = eps*eps + intp(m) = ((al0 - spv_ref) + lambda * I_pterm)*dp + 2.0*eps* & + lambda * eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + enddo + ! Use Boole's rule to integrate the values. + intx_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + & + 12.0*intp(3)) + enddo ; enddo ; endif + + if (present(inty_dza)) then ; do J=Jsq,Jeq ; do i=HI%isc,HI%iec + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., bathyP(i,j)-p_t(i,j+1), bathyP(i,j+1)-p_t(i,j)) + if (hWght > 0.) then + hL = (p_b(i,j) - p_t(i,j)) + dP_neglect + hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intp(1) = dza(i,j) ; intp(5) = dza(i,j+1) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + ! T, S, and p are interpolated in the horizontal. The p interpolation + ! is linear, but for T and S it may be thickness weighted. + al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1) + p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1) + lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1) + + dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1)) + p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i,j+1)+p_b(i,j+1))) + I_pterm = 1.0 / (p0 + p_ave) + + eps = 0.5 * dp * I_pterm ; eps2 = eps*eps + intp(m) = ((al0 - spv_ref) + lambda * I_pterm)*dp + 2.0*eps* & + lambda * eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + enddo + ! Use Boole's rule to integrate the values. + inty_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + & + 12.0*intp(3)) + enddo ; enddo ; endif +end subroutine int_spec_vol_dp_wright_full + + +!> \namespace mom_eos_wright_full +!! +!! \section section_EOS_Wright_full Wright equation of state +!! +!! Wright, 1997, provide an approximation for the in situ density as a function of +!! potential temperature, salinity, and pressure. The formula follow the Tumlirz +!! equation of state which are easier to evaluate and make efficient. +!! +!! Two ranges are provided by Wright: a "full" range and "reduced" range. The version in this +!! module uses the full range. +!! +!! Originally coded in 2000 by R. Hallberg. +!! Anomaly form coded in 3/18. +!! +!! \subsection section_EOS_Wright_full_references References +!! +!! Wright, D., 1997: An Equation of State for Use in Ocean Models: Eckart's Formula Revisited. +!! J. Ocean. Atmosph. Tech., 14 (3), 735-740. +!! https://journals.ametsoc.org/doi/abs/10.1175/1520-0426%281997%29014%3C0735%3AAEOSFU%3E2.0.CO%3B2 + +end module MOM_EOS_Wright_full diff --git a/src/equation_of_state/MOM_EOS_Wright_red.F90 b/src/equation_of_state/MOM_EOS_Wright_red.F90 new file mode 100644 index 0000000000..5553112274 --- /dev/null +++ b/src/equation_of_state/MOM_EOS_Wright_red.F90 @@ -0,0 +1,1033 @@ +!> The equation of state using the Wright 1997 expressions +module MOM_EOS_Wright_red + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_hor_index, only : hor_index_type + +implicit none ; private + +public calculate_compress_wright_red, calculate_density_wright_red, calculate_spec_vol_wright_red +public calculate_density_derivs_wright_red, calculate_specvol_derivs_wright_red +public calculate_density_second_derivs_wright_red, EoS_fit_range_Wright_red +public int_density_dz_wright_red, int_spec_vol_dp_wright_red +public avg_spec_vol_Wright_red + +!> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to +!! a reference density, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. +interface calculate_density_wright_red + module procedure calculate_density_scalar_wright, calculate_density_array_wright +end interface calculate_density_wright_red + +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect +!! to a reference specific volume, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. +interface calculate_spec_vol_wright_red + module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright +end interface calculate_spec_vol_wright_red + +!> Compute the derivatives of density with temperature and salinity +interface calculate_density_derivs_wright_red + module procedure calculate_density_derivs_scalar_wright, calculate_density_derivs_array_wright +end interface calculate_density_derivs_wright_red + +!> Compute the second derivatives of density with various combinations +!! of temperature, salinity, and pressure +interface calculate_density_second_derivs_wright_red + module procedure calculate_density_second_derivs_scalar_wright, calculate_density_second_derivs_array_wright +end interface calculate_density_second_derivs_wright_red + +!>@{ Parameters in the Wright equation of state using the reduced range formula, which is a fit to the UNESCO +! equation of state for the restricted range: -2 < theta < 30 [degC], 28 < S < 38 [PSU], 0 < p < 5e7 [Pa]. + + ! Note that a0/a1 ~= 2028 [degC] ; a0/a2 ~= -6343 [PSU] + ! b0/b1 ~= 165 [degC] ; b0/b4 ~= 974 [PSU] + ! c0/c1 ~= 216 [degC] ; c0/c4 ~= -740 [PSU] +real, parameter :: a0 = 7.057924e-4 ! A parameter in the Wright alpha_0 fit [m3 kg-1] +real, parameter :: a1 = 3.480336e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 degC-1] +real, parameter :: a2 = -1.112733e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 PSU-1] +real, parameter :: b0 = 5.790749e8 ! A parameter in the Wright p_0 fit [Pa] +real, parameter :: b1 = 3.516535e6 ! A parameter in the Wright p_0 fit [Pa degC-1] +real, parameter :: b2 = -4.002714e4 ! A parameter in the Wright p_0 fit [Pa degC-2] +real, parameter :: b3 = 2.084372e2 ! A parameter in the Wright p_0 fit [Pa degC-3] +real, parameter :: b4 = 5.944068e5 ! A parameter in the Wright p_0 fit [Pa PSU-1] +real, parameter :: b5 = -9.643486e3 ! A parameter in the Wright p_0 fit [Pa degC-1 PSU-1] +real, parameter :: c0 = 1.704853e5 ! A parameter in the Wright lambda fit [m2 s-2] +real, parameter :: c1 = 7.904722e2 ! A parameter in the Wright lambda fit [m2 s-2 degC-1] +real, parameter :: c2 = -7.984422 ! A parameter in the Wright lambda fit [m2 s-2 degC-2] +real, parameter :: c3 = 5.140652e-2 ! A parameter in the Wright lambda fit [m2 s-2 degC-3] +real, parameter :: c4 = -2.302158e2 ! A parameter in the Wright lambda fit [m2 s-2 PSU-1] +real, parameter :: c5 = -3.079464 ! A parameter in the Wright lambda fit [m2 s-2 degC-1 PSU-1] +!>@} + +contains + +!> Computes the in situ density of sea water for scalar inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]), and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. +subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] + + T0(1) = T + S0(1) = S + pressure0(1) = pressure + + call calculate_density_array_wright(T0, S0, pressure0, rho0, 1, 1, rho_ref) + rho = rho0(1) + +end subroutine calculate_density_scalar_wright + +!> Computes the in situ density of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ density of sea water (rho in [kg m-3]) from salinity (S [PSU]), +!! potential temperature (T [degC]), and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. +subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ref) + real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(inout) :: rho !< in situ density [kg m-3]. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: al_TS ! The contributions of temperature and salinity to al0 [m3 kg-1] + real :: p_TSp ! A combination of the pressure and the temperature and salinity contributions to p0 [Pa] + real :: lam_TS ! The contributions of temperature and salinity to lambda [m2 s-2] + real :: pa_000 ! A corrected offset to the pressure, including contributions from rho_ref [Pa] + integer :: j + + if (present(rho_ref)) pa_000 = b0*(1.0 - a0*rho_ref) - rho_ref*c0 + if (present(rho_ref)) then ; do j=start,start+npts-1 + al_TS = a1*T(j) + a2*S(j) + al0 = a0 + al_TS + p_TSp = pressure(j) + (b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j)))) + lam_TS = c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) + + ! The following two expressions are mathematically equivalent. + ! rho(j) = (b0 + p0_TSp) / ((c0 + lam_TS) + al0*(b0 + p0_TSp)) - rho_ref + rho(j) = (pa_000 + (p_TSp - rho_ref*(p_TSp*al0 + (b0*al_TS + lam_TS)))) / & + ( (c0 + lam_TS) + al0*(b0 + p_TSp) ) + enddo ; else ; do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + rho(j) = (pressure(j) + p0) / (lambda + al0*(pressure(j) + p0)) + enddo ; endif + +end subroutine calculate_density_array_wright + +!> Computes the Wright in situ specific volume of sea water for scalar inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) + real, intent(in) :: T !< potential temperature relative to the surface [degC]. + real, intent(in) :: S !< salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] + + T0(1) = T ; S0(1) = S ; pressure0(1) = pressure + + call calculate_spec_vol_array_wright(T0, S0, pressure0, spv0, 1, 1, spv_ref) + specvol = spv0(1) +end subroutine calculate_spec_vol_scalar_wright + +!> Computes the Wright in situ specific volume of sea water for 1-d array inputs and outputs. +!! +!! Returns the in situ specific volume of sea water (specvol in [m3 kg-1]) from salinity (S [PSU]), +!! potential temperature (T [degC]) and pressure [Pa]. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740 with the reduced range fit coefficients. +!! If spv_ref is present, specvol is an anomaly from spv_ref. +subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, spv_ref) + real, dimension(:), intent(in) :: T !< potential temperature relative to the + !! surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(inout) :: specvol !< in situ specific volume [m3 kg-1]. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2], perhaps with + ! an offset to account for spv_ref + real :: al_TS ! The contributions of temperature and salinity to al0 [m3 kg-1] + real :: p_TSp ! A combination of the pressure and the temperature and salinity contributions to p0 [Pa] + real :: lam_000 ! A corrected offset to lambda, including contributions from spv_ref [m2 s-2] + integer :: j + + if (present(spv_ref)) then + lam_000 = c0 + (a0 - spv_ref)*b0 + do j=start,start+npts-1 + al_TS = a1*T(j) + a2*S(j) + p_TSp = pressure(j) + (b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j)))) + lambda = lam_000 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + ! This is equivalent to the expression below minus spv_ref, but less sensitive to roundoff. + specvol(j) = al_TS + (lambda + (a0 - spv_ref)*p_TSp) / (b0 + p_TSp) + enddo + else + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + specvol(j) = al0 + lambda / (pressure(j) + p0) + enddo + endif +end subroutine calculate_spec_vol_array_wright + +!> Return the thermal/haline expansion coefficients for 1-d array inputs and outputs +subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the + !! surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(inout), dimension(:) :: drho_dT !< The partial derivative of density with potential + !! temperature [kg m-3 degC-1]. + real, intent(inout), dimension(:) :: drho_dS !< The partial derivative of density with salinity, + !! in [kg m-3 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom2 ! The inverse of the square of the denominator of density in the Wright EOS [s4 m-4] + integer :: j + + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_denom2 = 1.0 / (lambda + al0*(pressure(j) + p0))**2 + drho_dT(j) = I_denom2 * (lambda * (b1 + (T(j)*(2.0*b2 + 3.0*b3*T(j)) + b5*S(j))) - & + (pressure(j)+p0) * ( (pressure(j)+p0)*a1 + (c1 + (T(j)*(c2*2.0 + c3*3.0*T(j)) + c5*S(j))) )) + drho_dS(j) = I_denom2 * (lambda * (b4 + b5*T(j)) - & + (pressure(j)+p0) * ( (pressure(j)+p0)*a2 + (c4 + c5*T(j)) )) + enddo + +end subroutine calculate_density_derivs_array_wright + +!> Return the thermal/haline expansion coefficients for scalar inputs and outputs +!! +!! The scalar version of calculate_density_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_dS) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature [kg m-3 degC-1]. + real, intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in [kg m-3 PSU-1]. + + ! Local variables needed to promote the input/output scalars to 1-element arrays + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! The derivative of density with temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! The derivative of density with salinity [kg m-3 PSU-1] + + T0(1) = T + S0(1) = S + P0(1) = pressure + call calculate_density_derivs_array_wright(T0, S0, P0, drdt0, drds0, 1, 1) + drho_dT = drdt0(1) + drho_dS = drds0(1) + +end subroutine calculate_density_derivs_scalar_wright + +!> Second derivatives of density with respect to temperature, salinity, and pressure for 1-d array inputs and outputs. +subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp, start, npts) + real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] + real, dimension(:), intent(in ) :: S !< Salinity [PSU] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + integer, intent(in ) :: start !< Starting index in T,S,P + integer, intent(in ) :: npts !< Number of points to loop over + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: p_p0 ! A local work variable combining the pressure and pressure + ! offset (p0 elsewhere) in the Wright EOS [Pa] + real :: dp0_dT ! The partial derivative of p0 with temperature [Pa degC-1] + real :: dp0_dS ! The partial derivative of p0 with salinity [Pa PSU-1] + real :: dlam_dT ! The partial derivative of lambda with temperature [m2 s-2 degC-1] + real :: dlam_dS ! The partial derivative of lambda with salinity [m2 s-2 degC-1] + real :: dRdT_num ! The numerator in the expression for drho_dT [Pa m2 s-2 degC-1] = [kg m s-4 degC-1] + real :: dRdS_num ! The numerator in the expression for drho_ds [Pa m2 s-2 PSU-1] = [kg m s-4 PSU-1] + real :: ddenom_dT ! The derivative of the denominator of density in the Wright EOS with temperature [m2 s-2 deg-1] + real :: ddenom_dS ! The derivative of the denominator of density in the Wright EOS with salinity [m2 s-2 PSU-1] + real :: I_denom ! The inverse of the denominator of density in the Wright EOS [s2 m-2] + real :: I_denom2 ! The inverse of the square of the denominator of density in the Wright EOS [s4 m-4] + real :: I_denom3 ! The inverse of the cube of the denominator of density in the Wright EOS [s6 m-6] + integer :: j + + do j = start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p_p0 = P(j) + ( b0 + (b4*S(j) + T(j)*(b1 + (b5*S(j) + T(j)*(b2 + b3*T(j))))) ) ! P + p0 + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + dp0_dT = b1 + (b5*S(j) + T(j)*(2.*b2 + 3.*b3*T(j))) + dp0_dS = b4 + b5*T(j) + dlam_dT = c1 + (c5*S(j) + T(j)*(2.*c2 + 3.*c3*T(j))) + dlam_dS = c4 + c5*T(j) + I_denom = 1.0 / (lambda + al0*p_p0) + I_denom2 = I_denom*I_denom + I_denom3 = I_denom*I_denom2 + + ddenom_dS = (dlam_dS + a2*p_p0) + al0*dp0_dS + ddenom_dT = (dlam_dT + a1*p_p0) + al0*dp0_dT + dRdS_num = dp0_dS*lambda - p_p0*(dlam_dS + a2*p_p0) + dRdT_num = dp0_dT*lambda - p_p0*(dlam_dT + a1*p_p0) + + ! In deriving the following, it is useful to note that: + ! rho(j) = p_p0 / (lambda + al0*p_p0) + ! drho_dp(j) = lambda * I_denom2 + ! drho_dT(j) = (dp0_dT*lambda - p_p0*(dlam_dT + a1*p_p0)) * I_denom2 = dRdT_num * I_denom2 + ! drho_dS(j) = (dp0_dS*lambda - p_p0*(dlam_dS + a2*p_p0)) * I_denom2 = dRdS_num * I_denom2 + drho_ds_ds(j) = -2.*(p_p0*(a2*dp0_dS)) * I_denom2 - 2.*(dRdS_num*ddenom_dS) * I_denom3 + drho_ds_dt(j) = ((b5*lambda - p_p0*(c5 + 2.*a2*dp0_dT)) + (dp0_dS*dlam_dT - dp0_dT*dlam_dS))*I_denom2 - & + 2.*(ddenom_dT*dRdS_num) * I_denom3 + drho_dt_dt(j) = 2.*((b2 + 3.*b3*T(j))*lambda - p_p0*((c2 + 3.*c3*T(j)) + a1*dp0_dT))*I_denom2 - & + 2.*(dRdT_num * ddenom_dT) * I_denom3 + + ! The following is a rearranged form that is equivalent to + ! drho_ds_dp(j) = dlam_dS * I_denom2 - 2.0 * lambda * (dlam_dS + a2*p_p0 + al0*dp0_ds) * Idenom3 + drho_ds_dp(j) = (-dlam_dS - 2.*a2*p_p0) * I_denom2 - (2.*al0*dRdS_num) * I_denom3 + drho_dt_dp(j) = (-dlam_dT - 2.*a1*p_p0) * I_denom2 - (2.*al0*dRdT_num) * I_denom3 + enddo + +end subroutine calculate_density_second_derivs_array_wright + +!> Second derivatives of density with respect to temperature, salinity, and pressure for scalar inputs. +!! +!! The scalar version of calculate_density_second_derivs promotes scalar inputs to 1-element array +!! and then demotes the output back to a scalar +subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & + drho_ds_dp, drho_dt_dp) + real, intent(in ) :: T !< Potential temperature referenced to 0 dbar + real, intent(in ) :: S !< Salinity [PSU] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect + !! to T [kg m-3 PSU-1 degC-1] + real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + ! Local variables + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] + + T0(1) = T + S0(1) = S + P0(1) = P + call calculate_density_second_derivs_array_wright(T0, S0, P0, drdsds, drdsdt, drdtdt, drdsdp, drdtdp, 1, 1) + drho_ds_ds = drdsds(1) + drho_ds_dt = drdsdt(1) + drho_dt_dt = drdtdt(1) + drho_ds_dp = drdsdp(1) + drho_dt_dp = drdtdp(1) + +end subroutine calculate_density_second_derivs_scalar_wright + +!> Return the partial derivatives of specific volume with temperature and salinity +!! for 1-d array inputs and outputs +subroutine calculate_specvol_derivs_wright_red(T, S, pressure, dSV_dT, dSV_dS, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! potential temperature [m3 kg-1 degC-1]. + real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! salinity [m3 kg-1 PSU-1]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of specific volume in the Wright EOS [Pa-1] + integer :: j + + do j=start,start+npts-1 +! al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + ! SV = al0 + lambda / (pressure(j) + p0) + + I_denom = 1.0 / (pressure(j) + p0) + dSV_dT(j) = a1 + I_denom * ((c1 + (T(j)*(2.0*c2 + 3.0*c3*T(j)) + c5*S(j))) - & + (I_denom * lambda) * (b1 + (T(j)*(2.0*b2 + 3.0*b3*T(j)) + b5*S(j)))) + dSV_dS(j) = a2 + I_denom * ((c4 + c5*T(j)) - & + (I_denom * lambda) * (b4 + b5*T(j))) + enddo + +end subroutine calculate_specvol_derivs_wright_red + +!> Computes the compressibility of seawater for 1-d array inputs and outputs +subroutine calculate_compress_wright_red(T, S, pressure, rho, drho_dp, start, npts) + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(inout), dimension(:) :: rho !< In situ density [kg m-3]. + real, intent(inout), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! [s2 m-2]. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + + ! Local variables + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of density in the Wright EOS [s2 m-2] + integer :: j + + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_denom = 1.0 / (lambda + al0*(pressure(j) + p0)) + rho(j) = (pressure(j) + p0) * I_denom + drho_dp(j) = lambda * I_denom**2 + enddo +end subroutine calculate_compress_wright_red + +!> Calculates analytical and nearly-analytical integrals, in pressure across layers, to determine +!! the layer-average specific volumes. There are essentially no free assumptions, apart from a +!! truncation in the series for log(1-eps/1+eps) that assumes that |eps| < 0.34. +subroutine avg_spec_vol_Wright_red(T, S, p_t, dp, SpV_avg, start, npts) + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface + !! [degC]. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: p_t !< Pressure at the top of the layer [Pa] + real, dimension(:), intent(in) :: dp !< Pressure change in the layer [Pa] + real, dimension(:), intent(inout) :: SpV_avg !< The vertical average specific volume + !! in the layer [m3 kg-1] + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + + ! Local variables + real :: al0 ! A term in the Wright EOS [m3 kg-1] + real :: p0 ! A term in the Wright EOS [Pa] + real :: lambda ! A term in the Wright EOS [m2 s-2] + real :: eps2 ! The square of a nondimensional ratio [nondim] + real :: I_pterm ! The inverse of p0 plus p_ave [Pa-1]. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0, C1_9 = 1.0/9.0 ! Rational constants [nondim] + integer :: j + + ! alpha(j) = al0 + lambda / (pressure(j) + p0) + do j=start,start+npts-1 + al0 = a0 + (a1*T(j) + a2*S(j)) + p0 = b0 + ( b4*S(j) + T(j) * (b1 + (T(j)*(b2 + b3*T(j)) + b5*S(j))) ) + lambda = c0 + ( c4*S(j) + T(j) * (c1 + (T(j)*(c2 + c3*T(j)) + c5*S(j))) ) + + I_pterm = 1.0 / (p0 + (p_t(j) + 0.5*dp(j))) + eps2 = (0.5 * dp(j) * I_pterm)**2 + SpV_avg(j) = al0 + (lambda * I_pterm) * & + (1.0 + eps2*(C1_3 + eps2*(0.2 + eps2*(C1_7 + eps2*C1_9)))) + enddo +end subroutine avg_spec_vol_Wright_red + +!> Return the range of temperatures, salinities and pressures for which the reduced-range equation +!! of state from Wright (1997) has been fitted to observations. Care should be taken when applying +!! this equation of state outside of its fit range. +subroutine EoS_fit_range_Wright_red(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: S_max !< The maximum practical salinity over which this EoS is fitted [PSU] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -2.0 + if (present(T_max)) T_max = 30.0 + if (present(S_min)) S_min = 28.0 + if (present(S_max)) S_max = 38.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 5.0e7 + +end subroutine EoS_fit_range_Wright_red + +!> Calculates analytical and nearly-analytical integrals, in geopotential across layers, of pressure +!! anomalies, which are required for calculating the finite-volume form pressure accelerations in a +!! Boussinesq model. There are essentially no free assumptions, apart from the use of Boole's rule +!! rule to do the horizontal integrals, and from a truncation in the series for log(1-eps/1+eps) +!! that assumes that |eps| < 0.34. +subroutine int_density_dz_wright_red(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, & + useMassWghtInterp, rho_scale, pres_scale, temp_scale, saln_scale, Z_0p) + type(hor_index_type), intent(in) :: HI !< The horizontal index type for the arrays. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: T !< Potential temperature relative to the surface + !! [C ~> degC]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: S !< Salinity [S ~> PSU]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted + !! out to reduce the magnitude of each of the integrals. + !! (The pressure is calculated as p~=-z*rho_0*G_e.) + real, intent(in) :: rho_0 !< Density [R ~> kg m-3], that is used + !! to calculate the pressure (as p~=-z*rho_0*G_e) + !! used in the equation of state. + real, intent(in) :: G_e !< The Earth's gravitational acceleration + !! [L2 Z-1 T-2 ~> m s-2]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(inout) :: dpa !< The change in the pressure anomaly across the + !! layer [R L2 T-2 ~> Pa]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer + !! of the pressure anomaly relative to the anomaly + !! at the top of the layer [R Z L2 T-2 ~> Pa m]. + real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & + optional, intent(inout) :: intx_dpa !< The integral in x of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the x grid spacing [R L2 T-2 ~> Pa]. + real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & + optional, intent(inout) :: inty_dpa !< The integral in y of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the y grid spacing [R L2 T-2 ~> Pa]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. + logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to + !! interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: rho_scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1 ~> 1] + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure + !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale + !! temperature into degC [degC C-1 ~> 1] + real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure + !! into PSU [PSU S-1 ~> 1]. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] + + ! Local variables + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [m3 kg-1] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: p0_2d ! A term in the Wright EOS [Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: lambda_2d ! A term in the Wright EOS [m2 s-2] + real :: al0 ! A term in the Wright EOS [m3 kg-1] + real :: p0 ! A term in the Wright EOS [Pa] + real :: lambda ! A term in the Wright EOS [m2 s-2] + real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. + real :: eps, eps2 ! A nondimensional ratio and its square [nondim] + real :: rem ! [kg m-1 s-2] + real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] + real :: g_Earth ! The gravitational acceleration [m2 Z-1 s-2 ~> m s-2] + real :: I_Rho ! The inverse of the Boussinesq density [m3 kg-1] + real :: rho_ref_mks ! The reference density in MKS units [kg m-3] + real :: p_ave ! The layer averaged pressure [Pa] + real :: I_al0 ! The inverse of al0 [kg m-3] + real :: I_Lzz ! The inverse of the denominator [Pa-1] + real :: dz ! The layer thickness [Z ~> m]. + real :: hWght ! A pressure-thickness below topography [Z ~> m]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. + real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa]. + real :: Pa_to_RL2_T2 ! A conversion factor of pressures from Pa to the output units indicated by + ! pres_scale [R L2 T-2 Pa-1 ~> 1]. + real :: z0pres ! The height at which the pressure is zero [Z ~> m] + real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] + real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] + real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] + real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] + real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] + real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] + real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] + logical :: do_massWeight ! Indicates whether to do mass weighting. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m + + ! These array bounds work for the indexing convention of the input arrays, but + ! on the computational domain defined for the output arrays. + Isq = HI%IscB ; Ieq = HI%IecB + Jsq = HI%JscB ; Jeq = HI%JecB + is = HI%isc ; ie = HI%iec + js = HI%jsc ; je = HI%jec + + if (present(pres_scale)) then + GxRho = pres_scale * G_e * rho_0 ; g_Earth = pres_scale * G_e + Pa_to_RL2_T2 = 1.0 / pres_scale + else + GxRho = G_e * rho_0 ; g_Earth = G_e + Pa_to_RL2_T2 = 1.0 + endif + if (present(rho_scale)) then + g_Earth = g_Earth * rho_scale + rho_ref_mks = rho_ref / rho_scale ; I_Rho = rho_scale / rho_0 + else + rho_ref_mks = rho_ref ; I_Rho = 1.0 / rho_0 + endif + z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p + + a1s = a1 ; a2s = a2 + b1s = b1 ; b2s = b2 ; b3s = b3 ; b4s = b4 ; b5s = b5 + c1s = c1 ; c2s = c2 ; c3s = c3 ; c4s = c4 ; c5s = c5 + + if (present(temp_scale)) then ; if (temp_scale /= 1.0) then + a1s = a1s * temp_scale + b1s = b1s * temp_scale ; b2s = b2s * temp_scale**2 + b3s = b3s * temp_scale**3 ; b5s = b5s * temp_scale + c1s = c1s * temp_scale ; c2s = c2s * temp_scale**2 + c3s = c3s * temp_scale**3 ; c5s = c5s * temp_scale + endif ; endif + + if (present(saln_scale)) then ; if (saln_scale /= 1.0) then + a2s = a2s * saln_scale + b4s = b4s * saln_scale ; b5s = b5s * saln_scale + c4s = c4s * saln_scale ; c5s = c5s * saln_scale + endif ; endif + + do_massWeight = .false. + if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then + do_massWeight = .true. + ! if (.not.present(bathyT)) call MOM_error(FATAL, "int_density_dz_generic: "//& + ! "bathyT must be present if useMassWghtInterp is present and true.") + ! if (.not.present(dz_neglect)) call MOM_error(FATAL, "int_density_dz_generic: "//& + ! "dz_neglect must be present if useMassWghtInterp is present and true.") + endif ; endif + + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + al0_2d(i,j) = a0 + (a1s*T(i,j) + a2s*S(i,j)) + p0_2d(i,j) = b0 + ( b4s*S(i,j) + T(i,j) * (b1s + (T(i,j)*(b2s + b3s*T(i,j)) + b5s*S(i,j))) ) + lambda_2d(i,j) = c0 + ( c4s*S(i,j) + T(i,j) * (c1s + (T(i,j)*(c2s + c3s*T(i,j)) + c5s*S(i,j))) ) + + al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) + + dz = z_t(i,j) - z_b(i,j) + p_ave = -GxRho*(0.5*(z_t(i,j)+z_b(i,j)) - z0pres) + + I_al0 = 1.0 / al0 + I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0) + eps = 0.5*(GxRho*dz)*I_Lzz ; eps2 = eps*eps + +! rho(j) = (pressure(j) + p0) / (lambda + al0*(pressure(j) + p0)) + + rho_anom = (p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks + rem = (I_Rho * (lambda * I_al0**2)) * (eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2)))) + dpa(i,j) = Pa_to_RL2_T2 * ((g_Earth*rho_anom)*dz - 2.0*eps*rem) + if (present(intz_dpa)) & + intz_dpa(i,j) = Pa_to_RL2_T2 * (0.5*(g_Earth*rho_anom)*dz**2 - dz*((1.0+eps)*rem)) + enddo ; enddo + + if (present(intx_dpa)) then ; do j=js,je ; do I=Isq,Ieq + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., -bathyT(i,j)-z_t(i+1,j), -bathyT(i+1,j)-z_t(i,j)) + if (hWght > 0.) then + hL = (z_t(i,j) - z_b(i,j)) + dz_neglect + hR = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) + p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) + lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) + + dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j)) + p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i+1,j)+z_b(i+1,j))) - z0pres) + + I_al0 = 1.0 / al0 + I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0) + eps = 0.5*(GxRho*dz)*I_Lzz ; eps2 = eps*eps + + intz(m) = Pa_to_RL2_T2 * ( (g_Earth*dz) * ((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks) - 2.0*eps * & + (I_Rho * (lambda * I_al0**2)) * (eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2)))) ) + enddo + ! Use Boole's rule to integrate the values. + intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3)) + enddo ; enddo ; endif + + if (present(inty_dpa)) then ; do J=Jsq,Jeq ; do i=is,ie + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., -bathyT(i,j)-z_t(i,j+1), -bathyT(i,j+1)-z_t(i,j)) + if (hWght > 0.) then + hL = (z_t(i,j) - z_b(i,j)) + dz_neglect + hR = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i,j+1) + p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i,j+1) + lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i,j+1) + + dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1)) + p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i,j+1)+z_b(i,j+1))) - z0pres) + + I_al0 = 1.0 / al0 + I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0) + eps = 0.5*(GxRho*dz)*I_Lzz ; eps2 = eps*eps + + intz(m) = Pa_to_RL2_T2 * ( (g_Earth*dz) * ((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks) - 2.0*eps * & + (I_Rho * (lambda * I_al0**2)) * (eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2)))) ) + enddo + ! Use Boole's rule to integrate the values. + inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3)) + enddo ; enddo ; endif + +end subroutine int_density_dz_wright_red + +!> Calculates analytical and nearly-analytical integrals, in pressure across layers, of geopotential +!! anomalies, which are required for calculating the finite-volume form pressure accelerations in a +!! non-Boussinesq model. There are essentially no free assumptions, apart from the use of Boole's +!! rule to do the horizontal integrals, and from a truncation in the series for log(1-eps/1+eps) +!! that assumes that |eps| < 0.34. +subroutine int_spec_vol_dp_wright_red(T, S, p_t, p_b, spv_ref, HI, dza, & + intp_dza, intx_dza, inty_dza, halo_size, bathyP, dP_neglect, & + useMassWghtInterp, SV_scale, pres_scale, temp_scale, saln_scale) + type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: T !< Potential temperature relative to the surface + !! [C ~> degC]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: S !< Salinity [S ~> PSU]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] + real, intent(in) :: spv_ref !< A mean specific volume that is subtracted out + !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1]. + !! The calculation is mathematically identical with different values of + !! spv_ref, but this reduces the effects of roundoff. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(inout) :: dza !< The change in the geopotential anomaly across + !! the layer [L2 T-2 ~> m2 s-2]. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of + !! the geopotential anomaly relative to the anomaly + !! at the bottom of the layer [R L4 T-4 ~> Pa m2 s-2] + real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & + optional, intent(inout) :: intx_dza !< The integral in x of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the x grid spacing + !! [L2 T-2 ~> m2 s-2]. + real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & + optional, intent(inout) :: inty_dza !< The integral in y of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the y grid spacing + !! [L2 T-2 ~> m2 s-2]. + integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate + !! dza. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] + real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with + !! the same units as p_t [R L2 T-2 ~> Pa] + logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting + !! to interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: SV_scale !< A multiplicative factor by which to scale specific + !! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure + !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale + !! temperature into degC [degC C-1 ~> 1] + real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure + !! into PSU [PSU S-1 ~> 1]. + + ! Local variables + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [R-1 ~> m3 kg-1] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: p0_2d ! A term in the Wright EOS [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: lambda_2d ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] + real :: al0 ! A term in the Wright EOS [R-1 ~> m3 kg-1] + real :: p0 ! A term in the Wright EOS [R L2 T-2 ~> Pa] + real :: lambda ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] + real :: al0_scale ! Scaling factor to convert al0 from MKS units [R-1 kg m-3 ~> 1] + real :: p0_scale ! Scaling factor to convert p0 from MKS units [R L2 T-2 Pa-1 ~> 1] + real :: lam_scale ! Scaling factor to convert lambda from MKS units [L2 s2 T-2 m-2 ~> 1] + real :: p_ave ! The layer average pressure [R L2 T-2 ~> Pa] + real :: rem ! [L2 T-2 ~> m2 s-2] + real :: eps, eps2 ! A nondimensional ratio and its square [nondim] + real :: alpha_anom ! The depth averaged specific volume anomaly [R-1 ~> m3 kg-1]. + real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa]. + real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa]. + real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2]. + real :: I_pterm ! The inverse of p0 plus p_ave [T2 R-1 L-2 ~> Pa-1]. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. + real :: intp(5) ! The integrals of specific volume with pressure at the + ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. + real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] + real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] + real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] + real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] + real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] + real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] + real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] + logical :: do_massWeight ! Indicates whether to do mass weighting. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] + integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, halo + + Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB + halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) + ish = HI%isc-halo ; ieh = HI%iec+halo ; jsh = HI%jsc-halo ; jeh = HI%jec+halo + if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh) ; endif + if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh) ; endif + + + al0_scale = 1.0 ; if (present(SV_scale)) al0_scale = SV_scale + p0_scale = 1.0 + if (present(pres_scale)) then ; if (pres_scale /= 1.0) then + p0_scale = 1.0 / pres_scale + endif ; endif + lam_scale = al0_scale * p0_scale + + a1s = a1 ; a2s = a2 + b1s = b1 ; b2s = b2 ; b3s = b3 ; b4s = b4 ; b5s = b5 + c1s = c1 ; c2s = c2 ; c3s = c3 ; c4s = c4 ; c5s = c5 + + if (present(temp_scale)) then ; if (temp_scale /= 1.0) then + a1s = a1s * temp_scale + b1s = b1s * temp_scale ; b2s = b2s * temp_scale**2 + b3s = b3s * temp_scale**3 ; b5s = b5s * temp_scale + c1s = c1s * temp_scale ; c2s = c2s * temp_scale**2 + c3s = c3s * temp_scale**3 ; c5s = c5s * temp_scale + endif ; endif + + if (present(saln_scale)) then ; if (saln_scale /= 1.0) then + a2s = a2s * saln_scale + b4s = b4s * saln_scale ; b5s = b5s * saln_scale + c4s = c4s * saln_scale ; c5s = c5s * saln_scale + endif ; endif + + do_massWeight = .false. + if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then + do_massWeight = .true. +! if (.not.present(bathyP)) call MOM_error(FATAL, "int_spec_vol_dp_generic: "//& +! "bathyP must be present if useMassWghtInterp is present and true.") +! if (.not.present(dP_neglect)) call MOM_error(FATAL, "int_spec_vol_dp_generic: "//& +! "dP_neglect must be present if useMassWghtInterp is present and true.") + endif ; endif + + ! alpha(j) = (lambda + al0*(pressure(j) + p0)) / (pressure(j) + p0) + do j=jsh,jeh ; do i=ish,ieh + al0_2d(i,j) = al0_scale * ( a0 + (a1s*T(i,j) + a2s*S(i,j)) ) + p0_2d(i,j) = p0_scale * ( b0 + ( b4s*S(i,j) + T(i,j) * (b1s + (T(i,j)*(b2s + b3s*T(i,j)) + b5s*S(i,j))) ) ) + lambda_2d(i,j) = lam_scale * ( c0 + ( c4s*S(i,j) + T(i,j) * (c1s + (T(i,j)*(c2s + c3s*T(i,j)) + c5s*S(i,j))) ) ) + + al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) + dp = p_b(i,j) - p_t(i,j) + p_ave = 0.5*(p_t(i,j)+p_b(i,j)) + I_pterm = 1.0 / (p0 + p_ave) + + eps = 0.5 * dp * I_pterm ; eps2 = eps*eps + alpha_anom = (al0 - spv_ref) + lambda * I_pterm + rem = (lambda * eps2) * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + dza(i,j) = alpha_anom*dp + 2.0*eps*rem + if (present(intp_dza)) & + intp_dza(i,j) = 0.5*alpha_anom*dp**2 - dp*((1.0-eps)*rem) + enddo ; enddo + + if (present(intx_dza)) then ; do j=HI%jsc,HI%jec ; do I=Isq,Ieq + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., bathyP(i,j)-p_t(i+1,j), bathyP(i+1,j)-p_t(i,j)) + if (hWght > 0.) then + hL = (p_b(i,j) - p_t(i,j)) + dP_neglect + hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intp(1) = dza(i,j) ; intp(5) = dza(i+1,j) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + ! T, S, and p are interpolated in the horizontal. The p interpolation + ! is linear, but for T and S it may be thickness weighted. + al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) + p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) + lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) + + dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j)) + p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i+1,j)+p_b(i+1,j))) + I_pterm = 1.0 / (p0 + p_ave) + + eps = 0.5 * dp * I_pterm ; eps2 = eps*eps + intp(m) = ((al0 - spv_ref) + lambda * I_pterm)*dp + 2.0*eps* & + lambda * eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + enddo + ! Use Boole's rule to integrate the values. + intx_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + & + 12.0*intp(3)) + enddo ; enddo ; endif + + if (present(inty_dza)) then ; do J=Jsq,Jeq ; do i=HI%isc,HI%iec + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation of + ! T & S along the top and bottom integrals, akin to thickness weighting. + hWght = 0.0 + if (do_massWeight) & + hWght = max(0., bathyP(i,j)-p_t(i,j+1), bathyP(i,j+1)-p_t(i,j)) + if (hWght > 0.) then + hL = (p_b(i,j) - p_t(i,j)) + dP_neglect + hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR ) + hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom + hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom + else + hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0 + endif + + intp(1) = dza(i,j) ; intp(5) = dza(i,j+1) + do m=2,4 + wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L + wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR + + ! T, S, and p are interpolated in the horizontal. The p interpolation + ! is linear, but for T and S it may be thickness weighted. + al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1) + p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1) + lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1) + + dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1)) + p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i,j+1)+p_b(i,j+1))) + I_pterm = 1.0 / (p0 + p_ave) + + eps = 0.5 * dp * I_pterm ; eps2 = eps*eps + intp(m) = ((al0 - spv_ref) + lambda * I_pterm)*dp + 2.0*eps* & + lambda * eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + enddo + ! Use Boole's rule to integrate the values. + inty_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + & + 12.0*intp(3)) + enddo ; enddo ; endif +end subroutine int_spec_vol_dp_wright_red + + +!> \namespace mom_eos_wright_red +!! +!! \section section_EOS_Wright_red Wright equation of state +!! +!! Wright, 1997, provide an approximation for the in situ density as a function of +!! potential temperature, salinity, and pressure. The formula follow the Tumlirz +!! equation of state which are easier to evaluate and make efficient. +!! +!! Two ranges are provided by Wright: a "full" range and "reduced" range. The version in this +!! module uses the reduced range. +!! +!! Originally coded in 2000 by R. Hallberg. +!! Anomaly form coded in 3/18. +!! +!! \subsection section_EOS_Wright_red_references References +!! +!! Wright, D., 1997: An Equation of State for Use in Ocean Models: Eckart's Formula Revisited. +!! J. Ocean. Atmosph. Tech., 14 (3), 735-740. +!! https://journals.ametsoc.org/doi/abs/10.1175/1520-0426%281997%29014%3C0735%3AAEOSFU%3E2.0.CO%3B2 + +end module MOM_EOS_Wright_red diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index dd45e6cd81..b1dacf2780 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -7,14 +7,13 @@ module MOM_EOS_linear implicit none ; private -#include - public calculate_compress_linear, calculate_density_linear, calculate_spec_vol_linear public calculate_density_derivs_linear, calculate_density_derivs_scalar_linear public calculate_specvol_derivs_linear public calculate_density_scalar_linear, calculate_density_array_linear -public calculate_density_second_derivs_linear +public calculate_density_second_derivs_linear, EoS_fit_range_linear public int_density_dz_linear, int_spec_vol_dp_linear +public avg_spec_vol_linear ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -119,7 +118,7 @@ subroutine calculate_spec_vol_scalar_linear(T, S, pressure, specvol, & real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. if (present(spv_ref)) then - specvol = ((1.0 - Rho_T0_S0*spv_ref) + spv_ref*(dRho_dT*T + dRho_dS*S)) / & + specvol = ((1.0 - Rho_T0_S0*spv_ref) - spv_ref*(dRho_dT*T + dRho_dS*S)) / & ( Rho_T0_S0 + (dRho_dT*T + dRho_dS*S)) else specvol = 1.0 / ( Rho_T0_S0 + (dRho_dT*T + dRho_dS*S)) @@ -148,7 +147,7 @@ subroutine calculate_spec_vol_array_linear(T, S, pressure, specvol, start, npts, integer :: j if (present(spv_ref)) then ; do j=start,start+npts-1 - specvol(j) = ((1.0 - Rho_T0_S0*spv_ref) + spv_ref*(dRho_dT*T(j) + dRho_dS*S(j))) / & + specvol(j) = ((1.0 - Rho_T0_S0*spv_ref) - spv_ref*(dRho_dT*T(j) + dRho_dS*S(j))) / & ( Rho_T0_S0 + (dRho_dT*T(j) + dRho_dS*S(j))) enddo ; else ; do j=start,start+npts-1 specvol(j) = 1.0 / ( Rho_T0_S0 + (dRho_dT*T(j) + dRho_dS*S(j))) @@ -294,7 +293,7 @@ end subroutine calculate_specvol_derivs_linear !> This subroutine computes the in situ density of sea water (rho) !! and the compressibility (drho/dp == C_sound^-2) at the given !! salinity, potential temperature, and pressure. -subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,& +subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface !! [degC]. @@ -320,6 +319,49 @@ subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,& enddo end subroutine calculate_compress_linear +!> Calculates the layer average specific volumes. +subroutine avg_spec_vol_linear(T, S, p_t, dp, SpV_avg, start, npts, Rho_T0_S0, dRho_dT, dRho_dS) + real, dimension(:), intent(in) :: T !< Potential temperature [degC] + real, dimension(:), intent(in) :: S !< Salinity [PSU] + real, dimension(:), intent(in) :: p_t !< Pressure at the top of the layer [Pa] + real, dimension(:), intent(in) :: dp !< Pressure change in the layer [Pa] + real, dimension(:), intent(inout) :: SpV_avg !< The vertical average specific volume + !! in the layer [m3 kg-1] + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3] + real, intent(in) :: dRho_dT !< The derivative of density with temperature + !! [kg m-3 degC-1] + real, intent(in) :: dRho_dS !< The derivative of density with salinity + !! [kg m-3 ppt-1] + ! Local variables + integer :: j + + do j=start,start+npts-1 + SpV_avg(j) = 1.0 / (Rho_T0_S0 + (dRho_dT*T(j) + dRho_dS*S(j))) + enddo +end subroutine avg_spec_vol_linear + +!> Return the range of temperatures, salinities and pressures for which the reduced-range equation +!! of state from Wright (1997) has been fitted to observations. Care should be taken when applying +!! this equation of state outside of its fit range. +subroutine EoS_fit_range_linear(T_min, T_max, S_min, S_max, p_min, p_max) + real, optional, intent(out) :: T_min !< The minimum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: T_max !< The maximum potential temperature over which this EoS is fitted [degC] + real, optional, intent(out) :: S_min !< The minimum salinity over which this EoS is fitted [ppt] + real, optional, intent(out) :: S_max !< The maximum salinity over which this EoS is fitted [ppt] + real, optional, intent(out) :: p_min !< The minimum pressure over which this EoS is fitted [Pa] + real, optional, intent(out) :: p_max !< The maximum pressure over which this EoS is fitted [Pa] + + if (present(T_min)) T_min = -273.0 + if (present(T_max)) T_max = 100.0 + if (present(S_min)) S_min = 0.0 + if (present(S_max)) S_max = 1000.0 + if (present(p_min)) p_min = 0.0 + if (present(p_max)) p_max = 1.0e9 + +end subroutine EoS_fit_range_linear + !> This subroutine calculates analytical and nearly-analytical integrals of !! pressure anomalies across layers, which are required for calculating the !! finite-volume form pressure accelerations in a Boussinesq model. diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index 16a64c89ed..faa103d094 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -5,13 +5,14 @@ module MOM_TFreeze !********+*********+*********+*********+*********+*********+*********+** !* The subroutines in this file determine the potential temperature * -!* at which sea-water freezes. * +!* or conservative temperature at which sea-water freezes. * !********+*********+*********+*********+*********+*********+*********+** use gsw_mod_toolbox, only : gsw_ct_freezing_exact implicit none ; private public calculate_TFreeze_linear, calculate_TFreeze_Millero, calculate_TFreeze_teos10 +public calculate_TFreeze_TEOS_poly !> Compute the freezing point potential temperature [degC] from salinity [ppt] and !! pressure [Pa] using a simple linear expression, with coefficients passed in as arguments. @@ -34,11 +35,17 @@ module MOM_TFreeze module procedure calculate_TFreeze_teos10_scalar, calculate_TFreeze_teos10_array end interface calculate_TFreeze_teos10 +!> Compute the freezing point conservative temperature [degC] from absolute salinity [g kg-1] and +!! pressure [Pa] using a rescaled and refactored version of the expressions from the TEOS10 package. +interface calculate_TFreeze_TEOS_poly + module procedure calculate_TFreeze_TEOS_poly_scalar, calculate_TFreeze_TEOS_poly_array +end interface calculate_TFreeze_TEOS_poly + contains -!> This subroutine computes the freezing point potential temperature -!! [degC] from salinity [ppt], and pressure [Pa] using a simple -!! linear expression, with coefficients passed in as arguments. +!> This subroutine computes the freezing point potential temperature [degC] from +!! salinity [ppt], and pressure [Pa] using a simple linear expression, +!! with coefficients passed in as arguments. subroutine calculate_TFreeze_linear_scalar(S, pres, T_Fr, TFr_S0_P0, & dTFr_dS, dTFr_dp) real, intent(in) :: S !< salinity [ppt]. @@ -66,7 +73,7 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & integer, intent(in) :: npts !< the number of values to calculate. real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0, [degC]. real, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity, - !! [degC PSU-1]. + !! [degC ppt-1]. real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, !! [degC Pa-1]. integer :: j @@ -94,13 +101,13 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) real, parameter :: cS2 = -2.154996e-4 ! A term in the freezing point fit [degC PSU-2] real, parameter :: dTFr_dp = -7.75e-8 ! Derivative of freezing point with pressure [degC Pa-1] - T_Fr = S*(cS1 + (cS3_2 * sqrt(max(S,0.0)) + cS2 * S)) + dTFr_dp*pres + T_Fr = S*(cS1 + (cS3_2 * sqrt(max(S, 0.0)) + cS2 * S)) + dTFr_dp*pres end subroutine calculate_TFreeze_Millero_scalar !> This subroutine computes the freezing point potential temperature !! [degC] from salinity [ppt], and pressure [Pa] using the expression -!! from Millero (1978) (and in appendix A of Gill 1982), but with the of the +!! from Millero (1978) (and in appendix A of Gill 1982), but with the !! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an !! expression for potential temperature (not in situ temperature), using a !! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). @@ -119,12 +126,82 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) integer :: j do j=start,start+npts-1 - T_Fr(j) = S(j)*(cS1 + (cS3_2 * sqrt(max(S(j),0.0)) + cS2 * S(j))) + & + T_Fr(j) = S(j)*(cS1 + (cS3_2 * sqrt(max(S(j), 0.0)) + cS2 * S(j))) + & dTFr_dp*pres(j) enddo end subroutine calculate_TFreeze_Millero_array +!> This subroutine computes the freezing point conservative temperature [degC] +!! from absolute salinity [g kg-1], and pressure [Pa] using a rescaled and +!! refactored version of the polynomial expressions from the TEOS10 package. +subroutine calculate_TFreeze_TEOS_poly_scalar(S, pres, T_Fr) + real, intent(in) :: S !< Absolute salinity [g kg-1]. + real, intent(in) :: pres !< Pressure [Pa]. + real, intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. + + ! Local variables + real, dimension(1) :: S0 ! Salinity at a point [g kg-1] + real, dimension(1) :: pres0 ! Pressure at a point [Pa] + real, dimension(1) :: tfr0 ! The freezing temperature [degC] + + S0(1) = S + pres0(1) = pres + + call calculate_TFreeze_TEOS_poly_array(S0, pres0, tfr0, 1, 1) + T_Fr = tfr0(1) + +end subroutine calculate_TFreeze_TEOS_poly_scalar + +!> This subroutine computes the freezing point conservative temperature [degC] +!! from absolute salinity [g kg-1], and pressure [Pa] using a rescaled and +!! refactored version of the polynomial expressions from the TEOS10 package. +subroutine calculate_TFreeze_TEOS_poly_array(S, pres, T_Fr, start, npts) + real, dimension(:), intent(in) :: S !< absolute salinity [g kg-1]. + real, dimension(:), intent(in) :: pres !< Pressure [Pa]. + real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. + integer, intent(in) :: start !< The starting point in the arrays + integer, intent(in) :: npts !< The number of values to calculate + + ! Local variables + real :: Sa ! Absolute salinity [g kg-1] = [ppt] + real :: rS ! Square root of salinity [ppt1/2] + ! The coefficients here use the notation TFab for contributions proportional to S**a/2 * P**b. + real, parameter :: TF00 = 0.017947064327968736 ! Freezing point coefficient [degC] + real, parameter :: TF20 = -6.076099099929818e-2 ! Freezing point coefficient [degC ppt-1] + real, parameter :: TF30 = 4.883198653547851e-3 ! Freezing point coefficient [degC ppt-3/2] + real, parameter :: TF40 = -1.188081601230542e-3 ! Freezing point coefficient [degC ppt-2] + real, parameter :: TF50 = 1.334658511480257e-4 ! Freezing point coefficient [degC ppt-5/2] + real, parameter :: TF60 = -8.722761043208607e-6 ! Freezing point coefficient [degC ppt-3] + real, parameter :: TF70 = 2.082038908808201e-7 ! Freezing point coefficient [degC ppt-7/2] + real, parameter :: TF01 = -7.389420998107497e-8 ! Freezing point coefficient [degC Pa-1] + real, parameter :: TF21 = -9.891538123307282e-11 ! Freezing point coefficient [degC ppt-1 Pa-1] + real, parameter :: TF31 = -8.987150128406496e-13 ! Freezing point coefficient [degC ppt-3/2 Pa-1] + real, parameter :: TF41 = 1.054318231187074e-12 ! Freezing point coefficient [degC ppt-2 Pa-1] + real, parameter :: TF51 = 3.850133554097069e-14 ! Freezing point coefficient [degC ppt-5/2 Pa-1] + real, parameter :: TF61 = -2.079022768390933e-14 ! Freezing point coefficient [degC ppt-3 Pa-1] + real, parameter :: TF71 = 1.242891021876471e-15 ! Freezing point coefficient [degC ppt-7/2 Pa-1] + real, parameter :: TF02 = -2.110913185058476e-16 ! Freezing point coefficient [degC Pa-2] + real, parameter :: TF22 = 3.831132432071728e-19 ! Freezing point coefficient [degC ppt-1 Pa-2] + real, parameter :: TF32 = 1.065556599652796e-19 ! Freezing point coefficient [degC ppt-3/2 Pa-2] + real, parameter :: TF42 = -2.078616693017569e-20 ! Freezing point coefficient [degC ppt-2 Pa-2] + real, parameter :: TF52 = 1.596435439942262e-21 ! Freezing point coefficient [degC ppt-5/2 Pa-2] + real, parameter :: TF03 = 2.295491578006229e-25 ! Freezing point coefficient [degC Pa-3] + real, parameter :: TF23 = -7.997496801694032e-27 ! Freezing point coefficient [degC ppt-1 Pa-3] + real, parameter :: TF33 = 8.756340772729538e-28 ! Freezing point coefficient [degC ppt-3/2 Pa-3] + real, parameter :: TF43 = 1.338002171109174e-29 ! Freezing point coefficient [degC ppt-2 Pa-3] + integer :: j + + do j=start,start+npts-1 + rS = sqrt(max(S(j), 0.0)) + T_Fr(j) = (TF00 + S(j)*(TF20 + rS*(TF30 + rS*(TF40 + rS*(TF50 + rS*(TF60 + rS*TF70)))))) & + + pres(j)*( (TF01 + S(j)*(TF21 + rS*(TF31 + rS*(TF41 + rS*(TF51 + rS*(TF61 + rS*TF71)))))) & + + pres(j)*((TF02 + S(j)*(TF22 + rS*(TF32 + rS*(TF42 + rS* TF52)))) & + + pres(j)*(TF03 + S(j)*(TF23 + rS*(TF33 + rS* TF43))) ) ) + enddo + +end subroutine calculate_TFreeze_TEOS_poly_array + !> This subroutine computes the freezing point conservative temperature [degC] !! from absolute salinity [g kg-1], and pressure [Pa] using the !! TEOS10 package. @@ -158,7 +235,6 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) ! Local variables real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar [dbar Pa-1] - real :: zs ! Salinity at a point [g kg-1] real :: zp ! Pressures in [dbar] integer :: j ! Assume sea-water contains no dissolved air. @@ -166,11 +242,10 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) do j=start,start+npts-1 !Conversions - zs = S(j) zp = pres(j)* Pa2db !Convert pressure from Pascal to decibar if (S(j) < -1.0e-10) cycle !Can we assume safely that this is a missing value? - T_Fr(j) = gsw_ct_freezing_exact(zs,zp,saturation_fraction) + T_Fr(j) = gsw_ct_freezing_exact(S(j), zp, saturation_fraction) enddo end subroutine calculate_TFreeze_teos10_array diff --git a/src/equation_of_state/MOM_temperature_convert.F90 b/src/equation_of_state/MOM_temperature_convert.F90 new file mode 100644 index 0000000000..ee4bc21e62 --- /dev/null +++ b/src/equation_of_state/MOM_temperature_convert.F90 @@ -0,0 +1,166 @@ +!> Functions to convert between conservative and potential temperature +module MOM_temperature_convert + +! This file is part of MOM6. See LICENSE.md for the license. + +implicit none ; private + +public poTemp_to_consTemp, consTemp_to_poTemp + +!>@{ Parameters in the temperature conversion code +real, parameter :: Sprac_Sref = (35.0/35.16504) ! The TEOS 10 conversion factor to go from + ! reference salinity to practical salinity [nondim] +real, parameter :: I_S0 = 0.025*Sprac_Sref ! The inverse of a plausible range of oceanic salinities [kg g-1] +real, parameter :: I_Ts = 0.025 ! The inverse of a plausible range of oceanic temperatures [degC-1] +real, parameter :: I_cp0 = 1.0/3991.86795711963 ! The inverse of the "specific heat" for use + ! with Conservative Temperature, as defined with TEOS10 [degC kg J-1] + +! The following are coefficients of contributions to conservative temperature as a function of the square root +! of normalized absolute salinity with an offset (zS) and potential temperature (T) with a contribution +! Hab * zS**a * T**b. The numbers here are copied directly from the corresponding gsw module, but +! the expressions here do not use the same nondimensionalization for pressure or temperature as they do. + +real, parameter :: H00 = 61.01362420681071*I_cp0 ! Tp to Tc fit constant [degC] +real, parameter :: H01 = 168776.46138048015*(I_cp0*I_Ts) ! Tp to Tc fit T coef. [nondim] +real, parameter :: H02 = -2735.2785605119625*(I_cp0*I_Ts**2) ! Tp to Tc fit T**2 coef. [degC-1] +real, parameter :: H03 = 2574.2164453821433*(I_cp0*I_Ts**3) ! Tp to Tc fit T**3 coef. [degC-2] +real, parameter :: H04 = -1536.6644434977543*(I_cp0*I_Ts**4) ! Tp to Tc fit T**4 coef. [degC-3] +real, parameter :: H05 = 545.7340497931629*(I_cp0*I_Ts**5) ! Tp to Tc fit T**5 coef. [degC-4] +real, parameter :: H06 = -50.91091728474331*(I_cp0*I_Ts**6) ! Tp to Tc fit T**6 coef. [degC-5] +real, parameter :: H07 = -18.30489878927802*(I_cp0*I_Ts**7) ! Tp to Tc fit T**7 coef. [degC-6] +real, parameter :: H20 = 268.5520265845071*I_cp0 ! Tp to Tc fit zS**2 coef. [degC] +real, parameter :: H21 = -12019.028203559312*(I_cp0*I_Ts) ! Tp to Tc fit zS**2 * T coef. [nondim] +real, parameter :: H22 = 3734.858026725145*(I_cp0*I_Ts**2) ! Tp to Tc fit zS**2 * T**2 coef. [degC-1] +real, parameter :: H23 = -2046.7671145057618*(I_cp0*I_Ts**3) ! Tp to Tc fit zS**2 * T**3 coef. [degC-2] +real, parameter :: H24 = 465.28655623826234*(I_cp0*I_Ts**4) ! Tp to Tc fit zS**2 * T**4 coef. [degC-3] +real, parameter :: H25 = -0.6370820302376359*(I_cp0*I_Ts**5) ! Tp to Tc fit zS**2 * T**5 coef. [degC-4] +real, parameter :: H26 = -10.650848542359153*(I_cp0*I_Ts**6) ! Tp to Tc fit zS**2 * T**6 coef. [degC-5] +real, parameter :: H30 = 937.2099110620707*I_cp0 ! Tp to Tc fit zS**3 coef. [degC] +real, parameter :: H31 = 588.1802812170108*(I_cp0*I_Ts) ! Tp to Tc fit zS** 3* T coef. [nondim] +real, parameter :: H32 = 248.39476522971285*(I_cp0*I_Ts**2) ! Tp to Tc fit zS**3 * T**2 coef. [degC-1] +real, parameter :: H33 = -3.871557904936333*(I_cp0*I_Ts**3) ! Tp to Tc fit zS**3 * T**3 coef. [degC-2] +real, parameter :: H34 = -2.6268019854268356*(I_cp0*I_Ts**4) ! Tp to Tc fit zS**3 * T**4 coef. [degC-3] +real, parameter :: H40 = -1687.914374187449*I_cp0 ! Tp to Tc fit zS**4 coef. [degC] +real, parameter :: H41 = 936.3206544460336*(I_cp0*I_Ts) ! Tp to Tc fit zS**4 * T coef. [nondim] +real, parameter :: H42 = -942.7827304544439*(I_cp0*I_Ts**2) ! Tp to Tc fit zS**4 * T**2 coef. [degC-1] +real, parameter :: H43 = 369.4389437509002*(I_cp0*I_Ts**3) ! Tp to Tc fit zS**4 * T**3 coef. [degC-2] +real, parameter :: H44 = -33.83664947895248*(I_cp0*I_Ts**4) ! Tp to Tc fit zS**4 * T**4 coef. [degC-3] +real, parameter :: H45 = -9.987880382780322*(I_cp0*I_Ts**5) ! Tp to Tc fit zS**4 * T**5 coef. [degC-4] +real, parameter :: H50 = 246.9598888781377*I_cp0 ! Tp to Tc fit zS**5 coef. [degC] +real, parameter :: H60 = 123.59576582457964*I_cp0 ! Tp to Tc fit zS**6 coef. [degC] +real, parameter :: H70 = -48.5891069025409*I_cp0 ! Tp to Tc fit zS**7 coef. [degC] + +!>@} + +contains + +!> Convert input potential temperature [degC] and absolute salinity [g kg-1] to returned +!! conservative temperature [degC] using the polynomial expressions from TEOS-10. +elemental real function poTemp_to_consTemp(T, Sa) result(Tc) + real, intent(in) :: T !< Potential temperature [degC] + real, intent(in) :: Sa !< Absolute salinity [g kg-1] + + ! Local variables + real :: x2 ! Absolute salinity normalized by a plausible salinity range [nondim] + real :: x ! Square root of normalized absolute salinity [nondim] + + x2 = max(I_S0 * Sa, 0.0) + x = sqrt(x2) + + Tc = H00 + (T*(H01 + T*(H02 + T*(H03 + T*(H04 + T*(H05 + T*(H06 + T* H07)))))) & + + x2*(H20 + (T*(H21 + T*(H22 + T*(H23 + T*(H24 + T*(H25 + T*H26))))) & + + x*(H30 + (T*(H31 + T*(H32 + T*(H33 + T* H34))) & + + x*(H40 + (T*(H41 + T*(H42 + T*(H43 + T*(H44 + T*H45)))) & + + x*(H50 + x*(H60 + x* H70)) )) )) )) ) + +end function poTemp_to_consTemp + + +!> Return the partial derivative of conservative temperature with potential temperature [nondim] +!! based on the polynomial expressions from TEOS-10. +elemental real function dTc_dTp(T, Sa) + real, intent(in) :: T !< Potential temperature [degC] + real, intent(in) :: Sa !< Absolute salinity [g kg-1] + + ! Local variables + real :: x2 ! Absolute salinity normalized by a plausible salinity range [nondim] + real :: x ! Square root of normalized absolute salinity [nondim] + + x2 = max(I_S0 * Sa, 0.0) + x = sqrt(x2) + + dTc_dTp = ( H01 + T*(2.*H02 + T*(3.*H03 + T*(4.*H04 + T*(5.*H05 + T*(6.*H06 + T*(7.*H07)))))) ) & + + x2*( (H21 + T*(2.*H22 + T*(3.*H23 + T*(4.*H24 + T*(5.*H25 + T*(6.*H26)))))) & + + x*( (H31 + T*(2.*H32 + T*(3.*H33 + T*(4.*H34)))) & + + x*(H41 + T*(2.*H42 + T*(3.*H43 + T*(4.*H44 + T*(5.*H45))))) ) ) + +end function dTc_dTp + + + +!> Convert input potential temperature [degC] and absolute salinity [g kg-1] to returned +!! conservative temperature [degC] by inverting the polynomial expressions from TEOS-10. +elemental real function consTemp_to_poTemp(Tc, Sa) result(Tp) + real, intent(in) :: Tc !< Conservative temperature [degC] + real, intent(in) :: Sa !< Absolute salinity [g kg-1] + + real :: Tp_num ! The numerator of a simple expression for potential temperature [degC] + real :: I_Tp_den ! The inverse of the denominator of a simple expression for potential temperature [nondim] + real :: Tc_diff ! The difference between an estimate of conservative temperature and its target [degC] + real :: Tp_old ! A previous estimate of the potential tempearture [degC] + real :: dTp_dTc ! The partial derivative of potential temperature with conservative temperature [nondim] + ! The following are coefficients in the nominator (TPNxx) or denominator (TPDxx) of a simple rational + ! expression that approximately converts conservative temperature to potential temperature. + real, parameter :: TPN00 = -1.446013646344788e-2 ! Simple fit numerator constant [degC] + real, parameter :: TPN10 = -3.305308995852924e-3*Sprac_Sref ! Simple fit numerator Sa coef. [degC ppt-1] + real, parameter :: TPN20 = 1.062415929128982e-4*Sprac_Sref**2 ! Simple fit numerator Sa**2 coef. [degC ppt-2] + real, parameter :: TPN01 = 9.477566673794488e-1 ! Simple fit numerator Tc coef. [nondim] + real, parameter :: TPN11 = 2.166591947736613e-3*Sprac_Sref ! Simple fit numerator Sa * Tc coef. [ppt-1] + real, parameter :: TPN02 = 3.828842955039902e-3 ! Simple fit numerator Tc**2 coef. [degC-1] + real, parameter :: TPD10 = 6.506097115635800e-4*Sprac_Sref ! Simple fit denominator Sa coef. [ppt-1] + real, parameter :: TPD01 = 3.830289486850898e-3 ! Simple fit denominator Tc coef. [degC-1] + real, parameter :: TPD02 = 1.247811760368034e-6 ! Simple fit denominator Tc**2 coef. [degC-2] + + ! Estimate the potential temperature and its derivative from an approximate rational function fit. + Tp_num = TPN00 + (Sa*(TPN10 + TPN20*Sa) + Tc*(TPN01 + (TPN11*Sa + TPN02*Tc))) + I_Tp_den = 1.0 / (1.0 + (TPD10*Sa + Tc*(TPD01 + TPD02*Tc))) + Tp = Tp_num*I_Tp_den + dTp_dTc = ((TPN01 + (TPN11*Sa + 2.*TPN02*Tc)) - (TPD01 + 2.*TPD02*Tc)*Tp)*I_Tp_den + + ! Start the 1.5 iterations through the modified Newton-Raphson iterative method, which is also known + ! as the Newton-McDougall method. In this case 1.5 iterations converge to 64-bit machine precision + ! for oceanographically relevant temperatures and salinities. + + Tc_diff = poTemp_to_consTemp(Tp, Sa) - Tc + Tp_old = Tp + Tp = Tp_old - Tc_diff*dTp_dTc + + dTp_dTc = 1.0 / dTc_dTp(0.5*(Tp + Tp_old), Sa) + + Tp = Tp_old - Tc_diff*dTp_dTc + Tc_diff = poTemp_to_consTemp(Tp, Sa) - Tc + Tp_old = Tp + + Tp = Tp_old - Tc_diff*dTp_dTc + +end function consTemp_to_poTemp + +!> \namespace MOM_temperature_conv +!! +!! \section MOM_temperature_conv Temperature conversions +!! +!! This module has functions that convert potential temperature to conservative temperature +!! and the reverse, as described in the TEOS-10 manual. This code was originally derived +!! from their corresponding routines in the gsw code package, but has had some refactoring so that the +!! answers are more likely to reproduce across compilers and levels of optimization. A complete +!! discussion of the thermodynamics of seawater and the definition of conservative temperature +!! can be found in IOC et al. (2010). +!! +!! \subsection section_temperature_conv_references References +!! +!! IOC, SCOR and IAPSO, 2010: The international thermodynamic equation of seawater - 2010: +!! Calculation and use of thermodynamic properties. Intergovernmental Oceanographic Commission, +!! Manuals and Guides No. 56, UNESCO (English), 196 pp. +!! (Available from www.teos-10.org/pubs/TEOS-10_Manual.pdf) + +end module MOM_temperature_convert diff --git a/src/equation_of_state/_Equation_of_State.dox b/src/equation_of_state/_Equation_of_State.dox index 791c7001b1..0e80c9652a 100644 --- a/src/equation_of_state/_Equation_of_State.dox +++ b/src/equation_of_state/_Equation_of_State.dox @@ -2,9 +2,10 @@ Within MOM6, there is a wrapper for the equation of state, so that all calls look the same from the rest of the model. The equation of state code has to calculate -not just in situ density, but also the compressibility and various derivatives of -the density. There is also code for computing specific volume and the -freezing temperature. +not just in situ or potential density, but also the compressibility and various +derivatives of the density. There is also code for computing specific volume and the +freezing temperature, and for converting between potential and conservative +temperatures and between practical and reference (or absolute) salinity. \section Linear_EOS Linear Equation of State @@ -12,51 +13,96 @@ Compute the required quantities with uniform values for \f$\alpha = \frac{\parti \rho}{\partial T}\f$ and \f$\beta = \frac{\partial \rho}{\partial S}\f$, (DRHO_DT, DRHO_DS in MOM_input, also uses RHO_T0_S0). -\section Wright_EOS Wright Equation of State +\section Wright_EOS Wright reduced range Equation of State -Compute the required quantities using the equation of state from \cite wright1997. -This equation of state is in the form: +Compute the required quantities using the equation of state from \cite wright1997 +as a function of potential temperature and practical salinity, with +coefficients based on the reduced-range (salinity from 28 to 38 PSU, temperature +from -2 to 30 degC and pressure up to 5000 dbar) fit to the UNESCO 1981 data. This +equation of state is in the form: \f[ \alpha(s, \theta, p) = A(s, \theta) + \frac{\lambda(s, \theta)}{P(s, \theta) + p} \f] where \f$A, \lambda\f$ and \f$P\f$ are functions only of \f$s\f$ and \f$\theta\f$ and \f$\alpha = 1/ \rho\f$ is the specific volume. This form is useful for the -pressure gradient computation as discussed in \ref section_PG. +pressure gradient computation as discussed in \ref section_PG. This EoS is selected +by setting EQN_OF_STATE = WRIGHT or WRIGHT_RED, which are mathematically equivalent, +but the latter is refactored for consistent answers between compiler settings. + +\section Wright_full_EOS Wright full range Equation of State + +Compute the required quantities using the equation of state from \cite wright1997 +as a function of potential temperature and practical salinity, with +coefficients based on a fit to the UNESCO 1981 data over the full range of +validity of that data (salinity from 0 to 40 PSU, temperatures from -2 to 40 +degC, and pressures up to 10000 dbar). The functional form of the WRIGHT_FULL +equation of state is the same as for WRIGHT or WRIGHT_RED, but with different +coefficients. + +\section Jackett06_EOS Jackett et al. (2006) Equation of State + +Compute the required quantities using the equation of state from Jackett et al. +(2006) as a function of potential temperature and practical salinity, with +coefficients based on a fit to the updated data that were later used to define +the TEOS-10 equation of state over the full range of validity of that data +(salinity from 0 to 42 PSU, temperatures from the freezing point to 40 degC, and +pressures up to 8500 dbar), but focused on the "oceanographic funnel" of +thermodynamic properties observed in the ocean. This equation of state is +commonly used in realistic Hycom simulations. -\section NEMO_EOS NEMO Equation of State +\section UNESCO_EOS UNESCO Equation of State -Compute the required quantities using the equation of state from \cite roquet2015. +Compute the required quantities using the equation of state from \cite jackett1995, +which uses potential temperature and practical salinity as state variables and is +a fit to the 1981 UNESCO equation of state with the same functional form but a +replacement of the temperature variable (the original uses in situ temperature). -\section UNESCO_EOS UNESCO Equation of State +\section ROQUET_RHO_EOS ROQUET_RHO Equation of State + +Compute the required quantities using the equation of state from \cite roquet2015, +which uses a 75-member polynomial for density as a function of conservative temperature +and absolute salinity, in a fit to the output from the full TEOS-10 equation of state. -Compute the required quantities using the equation of state from \cite jackett1995. +\section ROQUET_SPV_EOS ROQUET_SPV Equation of State + +Compute the required quantities using the specific volume oriented equation of state from +\cite roquet2015, which uses a 75-member polynomial for specific volume as a function of +conservative temperature and absolute salinity, in a fit to the output from the full +TEOS-10 equation of state. \section TEOS-10_EOS TEOS-10 Equation of State Compute the required quantities using the equation of state from -[TEOS-10](http://www.teos-10.org/). +[TEOS-10](http://www.teos-10.org/), with calls directly to the subroutines +in that code package. \section section_TFREEZE Freezing Temperature of Sea Water -There are three choices for computing the freezing point of sea water: +There are four choices for computing the freezing point of sea water: \li Linear The freezing temperature is a linear function of the salinity and pressure: \f[ T_{Fr} = (T_{Fr0} + a\,S) + b\,P \f] -where \f$T_{Fr0},a,b\f$ are contants which can be set in MOM_input (TFREEZE_S0_P0, +where \f$T_{Fr0},a,b\f$ are constants which can be set in MOM_input (TFREEZE_S0_P0, DTFREEZE_DS, DTFREEZE_DP). -\li Millero The \cite millero1978 equation is used, but modified so that it is a function -of potential temperature rather than in situ temperature: +\li Millero The \cite millero1978 equation is used to calculate the freezing +point from practical salinity and pressure, but modified so that returns a +potential temperature rather than an in situ temperature: \f[ T_{Fr} = S(a + (b \sqrt{\max(S,0.0)} + c\, S)) + d\,P \f] -where \f$a,b, c, d\f$ are fixed contants. +where \f$a,b, c, d\f$ are fixed constants. + +\li TEOS-10 The TEOS-10 package is used to compute the freezing conservative +temperature [degC] from absolute salinity [g/kg], and pressure [Pa]. This one or +TEOS_poly must be used if you are using the ROQUET_RHO, ROQUET_SPV or TEOS-10 +equation of state. -\li TEOS-10 The TEOS-10 package is used to compute the freezing conservative temperature -[degC] from absolute salinity [g/kg], and pressure [Pa]. This one must be used -if you are using the NEMO or TEOS-10 equation of state. +\li TEOS_poly A 23-term polynomial fit refactored from the TEOS-10 package is +used to compute the freezing conservative temperature [degC] from absolute +salinity [g/kg], and pressure [Pa]. */ diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 5d658c44a4..c92753be1e 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1426,7 +1426,7 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & real, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this parameter is not written to a doc file - character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file @@ -1464,7 +1464,7 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & real, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this parameter is not written to a doc file - character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file @@ -1789,7 +1789,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this parameter is not written to a doc file - character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file @@ -1837,7 +1837,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this parameter is not written to a doc file - character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 83e7718311..34d0b73cb9 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -16,7 +16,8 @@ module MOM_horizontal_regridding use MOM_interpolate, only : time_interp_external use MOM_interp_infra, only : run_horiz_interp, build_horiz_interp_weights use MOM_interp_infra, only : horiz_interp_type, horizontal_interp_init -use MOM_interp_infra, only : axistype, get_external_field_info, get_axis_data +use MOM_interp_infra, only : get_external_field_info +use MOM_interp_infra, only : external_field use MOM_time_manager, only : time_type use MOM_io, only : axis_info, get_axis_info, get_var_axes_info, MOM_read_data use MOM_io, only : read_attribute, read_variable @@ -308,6 +309,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its !! native horizontal grid, with units that change !! as the input data is interpreted [a] then [A ~> a] + real, dimension(:,:,:), allocatable :: tr_in_full !< A 3-d array for holding input data on the + !! model horizontal grid, with units that change + !! as the input data is interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: tr_inp !< Native horizontal grid data extended to the poles !! with units that change as the input data is !! interpreted [a] then [A ~> a] @@ -447,6 +451,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr if (is_ongrid) then allocate(tr_in(is:ie,js:je), source=0.0) + allocate(tr_in_full(is:ie,js:je,kd), source=0.0) allocate(mask_in(is:ie,js:je), source=0.0) else call horizontal_interp_init() @@ -469,14 +474,19 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. + + if (is_ongrid) then + start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = 1 + count(1) = ie-is+1 ; count(2) = je-js+1 ; count(3) = kd ; start(4) = 1 ; count(4) = 1 + call MOM_read_data(trim(filename), trim(varnam), tr_in_full, start, count, G%Domain) + endif + do k=1,kd mask_in(:,:) = 0.0 tr_out(:,:) = 0.0 if (is_ongrid) then - start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k - count(1) = ie-is+1 ; count(2) = je-js+1 ; count(3) = 1 ; start(4) = 1 ; count(4) = 1 - call MOM_read_data(trim(filename), trim(varnam), tr_in, start, count, G%Domain) + tr_in(is:ie,js:je) = tr_in_full(is:ie,js:je,k) do j=js,je do i=is,ie if (abs(tr_in(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then @@ -593,17 +603,20 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr enddo ! kd - deallocate(lon_in, lat_in) + if (allocated(lat_inp)) deallocate(lat_inp) + deallocate(tr_in) + if (allocated(tr_inp)) deallocate(tr_inp) + if (allocated(tr_in_full)) deallocate(tr_in_full) end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle -subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, & +subroutine horiz_interp_and_extrap_tracer_fms_id(field, Time, G, tr_z, mask_z, & z_in, z_edges_in, missing_value, scale, & homogenize, spongeOngrid, m_to_Z, & answers_2018, tr_iter_tol, answer_date) - integer, intent(in) :: fms_id !< A unique id used by the FMS time interpolator + type(external_field), intent(in) :: field !< Handle for the time interpolated field type(time_type), intent(in) :: Time !< A FMS time type type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z @@ -667,7 +680,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] logical :: add_np type(horiz_interp_type) :: Interp - type(axistype), dimension(4) :: axes_data + type(axis_info), dimension(4) :: axes_data integer :: is, ie, js, je ! compute domain indices integer :: isg, ieg, jsg, jeg ! global extent integer :: isd, ied, jsd, jed ! data domain indices @@ -716,7 +729,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, call cpu_clock_begin(id_clock_read) - call get_external_field_info(fms_id, size=fld_sz, axes=axes_data, missing=missing_val_in) + call get_external_field_info(field, size=fld_sz, axes=axes_data, missing=missing_val_in) missing_value = scale*missing_val_in verbosity = MOM_get_verbosity() @@ -727,8 +740,8 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, if (PRESENT(spongeOngrid)) is_ongrid = spongeOngrid if (.not. is_ongrid) then allocate(lon_in(id), lat_in(jd)) - call get_axis_data(axes_data(1), lon_in) - call get_axis_data(axes_data(2), lat_in) + call get_axis_info(axes_data(1), ax_data=lon_in) + call get_axis_info(axes_data(2), ax_data=lat_in) endif allocate(z_in(kd), z_edges_in(kd+1)) @@ -736,7 +749,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, allocate(tr_z(isd:ied,jsd:jed,kd), source=0.0) allocate(mask_z(isd:ied,jsd:jed,kd), source=0.0) - call get_axis_data(axes_data(3), z_in) + call get_axis_info(axes_data(3), ax_data=z_in) if (present(m_to_Z)) then ; do k=1,kd ; z_in(k) = m_to_Z * z_in(k) ; enddo ; endif @@ -790,7 +803,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, if (.not.is_ongrid) then if (is_root_pe()) & - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + call time_interp_external(field, Time, data_in, verbose=(verbosity>5), turns=turns) ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. @@ -897,7 +910,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, enddo ! kd else - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + call time_interp_external(field, Time, data_in, verbose=(verbosity>5), turns=turns) do k=1,kd do j=js,je do i=is,ie diff --git a/src/framework/MOM_interpolate.F90 b/src/framework/MOM_interpolate.F90 index 38a786e593..e131e8db9d 100644 --- a/src/framework/MOM_interpolate.F90 +++ b/src/framework/MOM_interpolate.F90 @@ -9,12 +9,14 @@ module MOM_interpolate use MOM_interp_infra, only : time_interp_external_init=>time_interp_extern_init use MOM_interp_infra, only : horiz_interp_type, get_external_field_info use MOM_interp_infra, only : run_horiz_interp, build_horiz_interp_weights +use MOM_interp_infra, only : external_field use MOM_time_manager, only : time_type implicit none ; private public :: time_interp_external, init_external_field, time_interp_external_init, get_external_field_info public :: horiz_interp_type, run_horiz_interp, build_horiz_interp_weights +public :: external_field !> Read a field based on model time, and rotate to the model domain. interface time_interp_external @@ -26,9 +28,8 @@ module MOM_interpolate contains !> Read a scalar field based on model time. -subroutine time_interp_external_0d(field_id, time, data_in, verbose, scale) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() +subroutine time_interp_external_0d(field, time, data_in, verbose, scale) + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, intent(inout) :: data_in !< The interpolated value logical, optional, intent(in) :: verbose !< If true, write verbose output for debugging @@ -48,7 +49,7 @@ subroutine time_interp_external_0d(field_id, time, data_in, verbose, scale) data_in = data_in * I_scale endif ; endif - call time_interp_extern(field_id, time, data_in, verbose=verbose) + call time_interp_extern(field, time, data_in, verbose=verbose) if (present(scale)) then ; if (scale /= 1.0) then ! Rescale data that has been newly set and restore the scaling of unset data. @@ -63,10 +64,9 @@ end subroutine time_interp_external_0d !> Read a 2d field from an external based on model time, potentially including horizontal !! interpolation and rotation of the data -subroutine time_interp_external_2d(field_id, time, data_in, interp, & +subroutine time_interp_external_2d(field, time, data_in, interp, & verbose, horz_interp, mask_out, turns, scale) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, dimension(:,:), intent(inout) :: data_in !< The array in which to store the interpolated values integer, optional, intent(in) :: interp !< A flag indicating the temporal interpolation method @@ -105,11 +105,11 @@ subroutine time_interp_external_2d(field_id, time, data_in, interp, & qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) if (qturns == 0) then - call time_interp_extern(field_id, time, data_in, interp=interp, & + call time_interp_extern(field, time, data_in, interp=interp, & verbose=verbose, horz_interp=horz_interp) else call allocate_rotated_array(data_in, [1,1], -qturns, data_pre_rot) - call time_interp_extern(field_id, time, data_pre_rot, interp=interp, & + call time_interp_extern(field, time, data_pre_rot, interp=interp, & verbose=verbose, horz_interp=horz_interp) call rotate_array(data_pre_rot, turns, data_in) deallocate(data_pre_rot) @@ -136,10 +136,9 @@ end subroutine time_interp_external_2d !> Read a 3d field based on model time, and rotate to the model grid -subroutine time_interp_external_3d(field_id, time, data_in, interp, & +subroutine time_interp_external_3d(field, time, data_in, interp, & verbose, horz_interp, mask_out, turns, scale) - integer, intent(in) :: field_id !< The integer index of the external field returned - !! from a previous call to init_external_field() + type(external_field), intent(in) :: field !< Handle for time interpolated field type(time_type), intent(in) :: time !< The target time for the data real, dimension(:,:,:), intent(inout) :: data_in !< The array in which to store the interpolated values integer, optional, intent(in) :: interp !< A flag indicating the temporal interpolation method @@ -178,11 +177,11 @@ subroutine time_interp_external_3d(field_id, time, data_in, interp, & qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) if (qturns == 0) then - call time_interp_extern(field_id, time, data_in, interp=interp, & + call time_interp_extern(field, time, data_in, interp=interp, & verbose=verbose, horz_interp=horz_interp) else call allocate_rotated_array(data_in, [1,1,1], -qturns, data_pre_rot) - call time_interp_extern(field_id, time, data_pre_rot, interp=interp, & + call time_interp_extern(field, time, data_pre_rot, interp=interp, & verbose=verbose, horz_interp=horz_interp) call rotate_array(data_pre_rot, turns, data_in) deallocate(data_pre_rot) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 1026216426..220a7d6bcf 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -100,6 +100,7 @@ module MOM_io module procedure MOM_read_data_2d module procedure MOM_read_data_2d_region module procedure MOM_read_data_3d + module procedure MOM_read_data_3d_region module procedure MOM_read_data_4d end interface MOM_read_data @@ -137,7 +138,7 @@ module MOM_io interface read_variable module procedure read_variable_0d, read_variable_0d_int module procedure read_variable_1d, read_variable_1d_int - module procedure read_variable_2d + module procedure read_variable_2d, read_variable_3d end interface read_variable !> Read a global or variable attribute from a named netCDF file using netCDF calls @@ -332,15 +333,20 @@ subroutine create_MOM_file(IO_handle, filename, vars, novars, fields, & IsgB = dG%IsgB ; IegB = dG%IegB ; JsgB = dG%JsgB ; JegB = dG%JegB endif - if (domain_set .and. (num_PEs() == 1)) thread = SINGLE_FILE - one_file = .true. if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then - call IO_handle%open(filename, action=OVERWRITE_FILE, threading=thread) + if (domain_set) then + call IO_handle%open(filename, action=OVERWRITE_FILE, & + MOM_domain=domain, threading=thread, fileset=SINGLE_FILE) + else + call IO_handle%open(filename, action=OVERWRITE_FILE, threading=thread, & + fileset=SINGLE_FILE) + endif else - call IO_handle%open(filename, action=OVERWRITE_FILE, MOM_domain=Domain) + call IO_handle%open(filename, action=OVERWRITE_FILE, MOM_domain=Domain, & + threading=thread, fileset=thread) endif ! Define the coordinates. @@ -765,13 +771,13 @@ function num_timelevels(filename, varname, min_dims) result(n_time) call get_var_sizes(filename, varname, ndims, sizes, match_case=.false., caller="num_timelevels") - n_time = sizes(ndims) + if (ndims > 0) n_time = sizes(ndims) if (present(min_dims)) then if (ndims < min_dims-1) then write(msg, '(I3)') min_dims call MOM_error(WARNING, "num_timelevels: variable "//trim(varname)//" in file "//& - trim(filename)//" has fewer than min_dims = "//trim(msg)//" dimensions.") + trim(filename)//" has fewer than min_dims = "//trim(msg)//" dimensions.") n_time = -1 elseif (ndims == min_dims - 1) then n_time = 0 @@ -861,12 +867,18 @@ subroutine read_var_sizes(filename, varname, ndims, sizes, match_case, caller, d ncid = ncid_in else call open_file_to_read(filename, ncid, success=success) - if (.not.success) return + if (.not.success) then + call MOM_error(WARNING, "Unsuccessfully attempted to open file "//trim(filename)) + return + endif endif ! Get the dimension sizes of the variable varname. call get_varid(varname, ncid, filename, varid, match_case=match_case, found=found) - if (.not.found) return + if (.not.found) then + call MOM_error(WARNING, "Could not find variable "//trim(varname)//" in file "//trim(filename)) + return + endif status = NF90_inquire_variable(ncid, varid, ndims=ndims) if (status /= NF90_NOERR) then @@ -1150,7 +1162,7 @@ subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) allocate(field_nread(field_ndims)) field_nread(:2) = field_shape(:2) field_nread(3:) = 1 - if (present(nread)) field_shape(:2) = nread(:2) + if (present(nread)) field_nread(:2) = nread(:2) rc = nf90_get_var(ncid, varid, var, field_start, field_nread) @@ -1171,6 +1183,119 @@ subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) call broadcast(var, size(var), blocking=.true.) end subroutine read_variable_2d + +subroutine read_variable_3d(filename, varname, var, start, nread, ncid_in) + character(len=*), intent(in) :: filename !< Name of file to be read + character(len=*), intent(in) :: varname !< Name of variable to be read + real, intent(out) :: var(:,:,:) !< Output array of variable [arbitrary] + integer, optional, intent(in) :: start(:) !< Starting index on each axis. + integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis + integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. + !! If absent, the file is opened and closed within this routine. + + integer :: ncid, varid + integer :: field_ndims, dim_len + integer, allocatable :: field_dimids(:), field_shape(:) + integer, allocatable :: field_start(:), field_nread(:) + integer :: i, rc + character(len=*), parameter :: hdr = "read_variable_3d: " + + ! Validate shape of start and nread + if (present(start)) then + if (size(start) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start must have at least two dimensions.") + endif + + if (present(nread)) then + if (size(nread) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread must have at least two dimensions.") + + if (any(nread(3:) > 1)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread may only read a single level in higher dimensions.") + endif + + ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure + ! that their lengths are equivalent, and must do it here. + if (present(start) .and. present(nread)) then + if (size(start) /= size(nread)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start and nread must have the same length.") + endif + + ! Open and read `varname` from `filename` + if (is_root_pe()) then + if (present(ncid_in)) then + ncid = ncid_in + else + call open_file_to_Read(filename, ncid) + endif + + call get_varid(varname, ncid, filename, varid, match_case=.false.) + if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//& + " in "//trim(filename)) + + ! Query for the dimensionality of the input field + rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + ! Confirm that field is at least 2d + if (field_ndims < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) // " " // & + trim(varname) // " from " // trim(filename) // " is not a 2D field.") + + ! If start and nread are present, then reshape them to match field dims + if (present(start) .or. present(nread)) then + allocate(field_shape(field_ndims)) + allocate(field_dimids(field_ndims)) + + rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + do i = 1, field_ndims + rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // ": Difficulties reading dimensions from " // trim(filename)) + field_shape(i) = dim_len + enddo + + ! Reshape start(:) and nreads(:) in case ranks differ + allocate(field_start(field_ndims)) + field_start(:) = 1 + if (present(start)) then + dim_len = min(size(start), size(field_start)) + field_start(:dim_len) = start(:dim_len) + endif + + allocate(field_nread(field_ndims)) + field_nread(:3) = field_shape(:3) + !field_nread(3:) = 1 + if (present(nread)) field_nread(:3) = nread(:3) + + rc = nf90_get_var(ncid, varid, var, field_start, field_nread) + + deallocate(field_start) + deallocate(field_nread) + deallocate(field_shape) + deallocate(field_dimids) + else + rc = nf90_get_var(ncid, varid, var) + endif + + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + " Difficulties reading "//trim(varname)//" from "//trim(filename)) + + if (.not.present(ncid_in)) call close_file_to_read(ncid, filename) + endif + + call broadcast(var, size(var), blocking=.true.) +end subroutine read_variable_3d + !> Read a character-string global or variable attribute subroutine read_attribute_str(filename, attname, att_val, varname, found, all_read, ncid_in) character(len=*), intent(in) :: filename !< Name of the file to read @@ -2187,6 +2312,42 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & endif end subroutine MOM_read_data_3d +!> Read a 3d region array from file using infrastructure I/O. +subroutine MOM_read_data_3d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale, turns) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] + integer, dimension(:), intent(in) :: start !< Starting index for each axis. + integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis. + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: no_domain !< If true, field does not use + !! domain decomposion. + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] + integer, optional, intent(in) :: turns !< Number of quarter turns from + !! input to model grid + + integer :: qturns ! Number of quarter turns + real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a] + + qturns = 0 + if (present(turns)) qturns = modulo(turns, 4) + + if (qturns == 0) then + call read_field(filename, fieldname, data, start, nread, & + MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale & + ) + else + call allocate_rotated_array(data, [1,1,1], -qturns, data_in) + call read_field(filename, fieldname, data_in, start, nread, & + MOM_Domain=MOM_Domain%domain_in, no_domain=no_domain, scale=scale & + ) + call rotate_array(data_in, qturns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_3d_region !> Read a 4d array from file using infrastructure I/O. subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & diff --git a/src/framework/MOM_io_file.F90 b/src/framework/MOM_io_file.F90 index e1613fbbb3..6eaa10f622 100644 --- a/src/framework/MOM_io_file.F90 +++ b/src/framework/MOM_io_file.F90 @@ -6,6 +6,8 @@ module MOM_io_file use, intrinsic :: iso_fortran_env, only : int64 use MOM_domains, only : MOM_domain_type, domain1D +use MOM_domains, only : clone_MOM_domain +use MOM_domains, only : deallocate_MOM_domain use MOM_io_infra, only : file_type, get_file_info, get_file_fields use MOM_io_infra, only : open_file, close_file, flush_file use MOM_io_infra, only : fms2_file_is_open => file_is_open @@ -14,6 +16,7 @@ module MOM_io_file use MOM_io_infra, only : write_field, write_metadata use MOM_io_infra, only : get_field_atts use MOM_io_infra, only : read_field_chksum +use MOM_io_infra, only : SINGLE_FILE use MOM_hor_index, only : hor_index_type use MOM_hor_index, only : hor_index_init @@ -248,6 +251,9 @@ module MOM_io_file type, extends(MOM_file) :: MOM_infra_file private + type(MOM_domain_type), public, pointer :: domain => null() + !< Internal domain used for single-file IO + ! NOTE: This will be made private after the API transition type(file_type), public :: handle_infra !< Framework-specific file handler content @@ -919,8 +925,23 @@ subroutine open_file_infra(handle, filename, action, MOM_domain, threading, file integer, intent(in), optional :: threading integer, intent(in), optional :: fileset - call open_file(handle%handle_infra, filename, action=action, & - MOM_domain=MOM_domain, threading=threading, fileset=fileset) + logical :: use_single_file_domain + ! True if the domain is replaced with a single-file IO layout. + + use_single_file_domain = .false. + if (present(MOM_domain) .and. present(fileset)) then + if (fileset == SINGLE_FILE) & + use_single_file_domain = .true. + endif + + if (use_single_file_domain) then + call clone_MOM_domain(MOM_domain, handle%domain, io_layout=[1,1]) + call open_file(handle%handle_infra, filename, action=action, & + MOM_domain=handle%domain, threading=threading, fileset=fileset) + else + call open_file(handle%handle_infra, filename, action=action, & + MOM_domain=MOM_domain, threading=threading, fileset=fileset) + endif call handle%axes%init() call handle%fields%init() @@ -930,6 +951,9 @@ end subroutine open_file_infra subroutine close_file_infra(handle) class(MOM_infra_file), intent(inout) :: handle + if (associated(handle%domain)) & + call deallocate_MOM_domain(handle%domain) + call close_file(handle%handle_infra) call handle%axes%finalize() call handle%fields%finalize() diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 24ba0fa76b..75051c32ba 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1860,7 +1860,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, nf = nf + 1 if (present(IO_handles)) & call IO_handles(nf)%open(trim(filepath), READONLY_FILE, & - threading=MULTIPLE, fileset=SINGLE_FILE) + MOM_domain=G%Domain, threading=MULTIPLE, fileset=SINGLE_FILE) if (present(global_files)) global_files(nf) = .true. if (present(file_paths)) file_paths(nf) = filepath elseif (CS%parallel_restartfiles) then @@ -1892,7 +1892,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, nf = nf + 1 if (present(IO_handles)) & call IO_handles(nf)%open(trim(filepath), READONLY_FILE, & - threading=MULTIPLE, fileset=SINGLE_FILE) + MOM_Domain=G%Domain, threading=MULTIPLE, fileset=SINGLE_FILE) if (present(global_files)) global_files(nf) = .true. if (present(file_paths)) file_paths(nf) = filepath if (is_root_pe() .and. (present(IO_handles))) & diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index bfc2189188..868352102e 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -30,10 +30,10 @@ module MOM_unit_scaling real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density [R m3 kg-1 ~> 1] real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram [J kg-1 Q-1 ~> 1] real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy [Q kg J-1 ~> 1] - real :: C_to_degC !< A constant that translates the units of temperature to degrees Celsius [degC C-1 ~> 1] - real :: degC_to_C !< A constant that translates degrees Celsius to the units of temperature [C degC-1 ~> 1] - real :: S_to_ppt !< A constant that translates the units of salinity to parts per thousand [ppt S-1 ~> 1] - real :: ppt_to_S !< A constant that translates parts per thousand to the units of salinity [S ppt-1 ~> 1] + real :: C_to_degC !< A constant that translates the units of temperature to degrees Celsius [degC C-1 ~> 1] + real :: degC_to_C !< A constant that translates degrees Celsius to the units of temperature [C degC-1 ~> 1] + real :: S_to_ppt !< A constant that translates the units of salinity to parts per thousand [ppt S-1 ~> 1] + real :: ppt_to_S !< A constant that translates parts per thousand to the units of salinity [S ppt-1 ~> 1] ! These are useful combinations of the fundamental scale conversion factors above. real :: Z_to_L !< Convert vertical distances to lateral lengths [L Z-1 ~> 1] @@ -52,14 +52,16 @@ module MOM_unit_scaling real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2 [W T3 R-1 Z-3 m-2 ~> 1] real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3 [R Z3 m2 T-3 W-1 ~> 1] real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa [Pa T2 R-1 L-2 ~> 1] - ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2 [R L2 T-2 Pa-1 ~> 1] - - ! These are used for changing scaling across restarts. - real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. - real :: m_to_L_restart = 0.0 !< A copy of the m_to_L that is used in restart files. - real :: s_to_T_restart = 0.0 !< A copy of the s_to_T that is used in restart files. - real :: kg_m3_to_R_restart = 0.0 !< A copy of the kg_m3_to_R that is used in restart files. - real :: J_kg_to_Q_restart = 0.0 !< A copy of the J_kg_to_Q that is used in restart files. + real :: RLZ_T2_to_Pa !< Convert wind stresses from R L Z T-2 to Pa [Pa T2 R-1 L-1 Z-1 ~> 1] + real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2 [R L2 T-2 Pa-1 ~> 1] + real :: Pa_to_RLZ_T2 !< Convert wind stresses from Pa to R L Z T-2 [R L Z T-2 Pa-1 ~> 1] + + ! These are no longer used for changing scaling across restarts. + real :: m_to_Z_restart = 1.0 !< A copy of the m_to_Z that is used in restart files. + real :: m_to_L_restart = 1.0 !< A copy of the m_to_L that is used in restart files. + real :: s_to_T_restart = 1.0 !< A copy of the s_to_T that is used in restart files. + real :: kg_m3_to_R_restart = 1.0 !< A copy of the kg_m3_to_R that is used in restart files. + real :: J_kg_to_Q_restart = 1.0 !< A copy of the J_kg_to_Q that is used in restart files. end type unit_scale_type contains @@ -218,8 +220,10 @@ subroutine set_unit_scaling_combos(US) US%QRZ_T_to_W_m2 = US%Q_to_J_kg * US%R_to_kg_m3 * US%Z_to_m * US%s_to_T ! Pressures: US%RL2_T2_to_Pa = US%R_to_kg_m3 * US%L_T_to_m_s**2 - ! It does not seem like US%Pa_to_RL2_T2 would be used enough in MOM6 to justify its existence. - ! US%Pa_to_RL2_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 + US%Pa_to_RL2_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 + ! Wind stresses: + US%RLZ_T2_to_Pa = US%R_to_kg_m3 * US%L_T_to_m_s**2 * US%Z_to_L + US%Pa_to_RLZ_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 * US%L_to_Z end subroutine set_unit_scaling_combos @@ -231,11 +235,11 @@ subroutine fix_restart_unit_scaling(US, unscaled) !! model would be unscaled, which is appropriate if the !! scaling is undone when writing a restart file. - US%m_to_Z_restart = US%m_to_Z - US%m_to_L_restart = US%m_to_L - US%s_to_T_restart = US%s_to_T - US%kg_m3_to_R_restart = US%kg_m3_to_R - US%J_kg_to_Q_restart = US%J_kg_to_Q + US%m_to_Z_restart = 1.0 ! US%m_to_Z + US%m_to_L_restart = 1.0 ! US%m_to_L + US%s_to_T_restart = 1.0 ! US%s_to_T + US%kg_m3_to_R_restart = 1.0 ! US%kg_m3_to_R + US%J_kg_to_Q_restart = 1.0 ! US%J_kg_to_Q if (present(unscaled)) then ; if (unscaled) then US%m_to_Z_restart = 1.0 diff --git a/src/framework/posix.F90 b/src/framework/posix.F90 index e5ec0e60d4..213ff4656d 100644 --- a/src/framework/posix.F90 +++ b/src/framework/posix.F90 @@ -137,7 +137,7 @@ function sleep_posix(seconds) result(rc) bind(c, name="sleep") !! returns 0. When `longjmp` is later called, the program is restored to the !! point where `setjmp` was called, except it now returns a value (rc) as !! specified by `longjmp`. - function setjmp(env) result(rc) bind(c, name="setjmp") + function setjmp(env) result(rc) bind(c, name=SETJMP_NAME) ! #include ! int setjmp(jmp_buf env); import :: jmp_buf, c_int @@ -175,7 +175,7 @@ end function sigsetjmp !> C interface to POSIX longjmp() !! Users should use the Fortran-defined longjmp() function. - subroutine longjmp_posix(env, val) bind(c, name="longjmp") + subroutine longjmp_posix(env, val) bind(c, name=LONGJMP_NAME) ! #include ! int longjmp(jmp_buf env, int val); import :: jmp_buf, c_int @@ -188,7 +188,7 @@ end subroutine longjmp_posix !> C interface to POSIX siglongjmp() !! Users should use the Fortran-defined siglongjmp() function. - subroutine siglongjmp_posix(env, val) bind(c, name="siglongjmp") + subroutine siglongjmp_posix(env, val) bind(c, name=SIGLONGJMP_NAME) ! #include ! int siglongjmp(jmp_buf env, int val); import :: sigjmp_buf, c_int @@ -344,11 +344,36 @@ subroutine siglongjmp(env, val) call siglongjmp_posix(env, val_c) end subroutine siglongjmp + +! Symbols in may be platform-dependent and may not exist if defined +! as a macro. The following functions permit compilation when they are +! unavailable, and report a runtime error if used in the program. + +!> Placeholder function for a missing or unconfigured setjmp +function setjmp_missing(env) result(rc) bind(c) + type(jmp_buf), intent(in) :: env + !< Current process state (unused) + integer(kind=c_int) :: rc + !< Function return code (unused) + + print '(a)', 'ERROR: setjmp() is not implemented in this build.' + print '(a)', 'Recompile with autoconf or -DSETJMP_NAME=\"\".' + error stop +end function setjmp_missing + +!> Placeholder function for a missing or unconfigured longjmp +subroutine longjmp_missing(env, val) bind(c) + type(jmp_buf), intent(in) :: env + !< Current process state (unused) + integer(kind=c_int), value, intent(in) :: val + !< Enable signal state flag (unused) + + print '(a)', 'ERROR: longjmp() is not implemented in this build.' + print '(a)', 'Recompile with autoconf or -DLONGJMP_NAME=\"\".' + error stop +end subroutine longjmp_missing + !> Placeholder function for a missing or unconfigured sigsetjmp -!! -!! The symbol for sigsetjmp can be platform-dependent and may not exist if -!! defined as a macro. This function allows compilation, and reports a runtime -!! error if used in the program. function sigsetjmp_missing(env, savesigs) result(rc) bind(c) type(sigjmp_buf), intent(in) :: env !< Current process state (unused) @@ -365,4 +390,16 @@ function sigsetjmp_missing(env, savesigs) result(rc) bind(c) rc = -1 end function sigsetjmp_missing +!> Placeholder function for a missing or unconfigured siglongjmp +subroutine siglongjmp_missing(env, val) bind(c) + type(sigjmp_buf), intent(in) :: env + !< Current process state (unused) + integer(kind=c_int), value, intent(in) :: val + !< Enable signal state flag (unused) + + print '(a)', 'ERROR: siglongjmp() is not implemented in this build.' + print '(a)', 'Recompile with autoconf or -DSIGLONGJMP_NAME=\"\".' + error stop +end subroutine siglongjmp_missing + end module posix diff --git a/src/framework/posix.h b/src/framework/posix.h index 96dec57814..f7cea0fec9 100644 --- a/src/framework/posix.h +++ b/src/framework/posix.h @@ -12,12 +12,24 @@ #define SIZEOF_SIGJMP_BUF SIZEOF_JMP_BUF #endif -! glibc defines sigsetjmp as __sigsetjmp via macro readable from . +! Wrappers to are disabled on default. +#ifndef SETJMP_NAME +#define SETJMP_NAME "setjmp_missing" +#endif + +#ifndef LONGJMP_NAME +#define LONGJMP_NAME "longjmp_missing" +#endif + #ifndef SIGSETJMP_NAME #define SIGSETJMP_NAME "sigsetjmp_missing" #endif -! This should be defined by /usr/include/signal.h +#ifndef SIGLONGJMP_NAME +#define SIGLONGJMP_NAME "siglongjmp_missing" +#endif + +! This should be defined by ; ! If unset, we use the most common (x86) value #ifndef POSIX_SIGUSR1 #define POSIX_SIGUSR1 10 diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a78c17803c..8e0e58c1b6 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -61,6 +61,7 @@ module MOM_ice_shelf use MOM_spatial_means, only : global_area_integral use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum use MOM_interpolate, only : init_external_field, time_interp_external, time_interp_external_init +use MOM_interpolate, only : external_field implicit none ; private @@ -196,10 +197,10 @@ module MOM_ice_shelf id_shelf_sfc_mass_flux = -1 !>@} - integer :: id_read_mass !< An integer handle used in time interpolation of - !! the ice shelf mass read from a file - integer :: id_read_area !< An integer handle used in time interpolation of - !! the ice shelf mass read from a file + type(external_field) :: mass_handle + !< Handle for reading the time interpolated ice shelf mass from a file + type(external_field) :: area_handle + !< Handle for reading the time interpolated ice shelf area from a file type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. type(user_ice_shelf_CS), pointer :: user_CS => NULL() !< A pointer to the control structure for @@ -1118,7 +1119,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes) do j=js,je ; do i=is,ie last_hmask(i,j) = ISS%hmask(i,j) ; last_area_shelf_h(i,j) = ISS%area_shelf_h(i,j) enddo ; enddo - call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) + call time_interp_external(CS%mass_handle, Time0, last_mass_shelf) do j=js,je ; do i=is,ie ! This should only be done if time_interp_extern did an update. last_mass_shelf(i,j) = US%kg_m3_to_R*US%m_to_Z * last_mass_shelf(i,j) ! Rescale after time_interp @@ -1222,12 +1223,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, !! the ice-shelf state type(directories) :: dirs type(dyn_horgrid_type), pointer :: dG => NULL() - real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a restart file to the internal representation in this run. - real :: RZ_rescale ! A rescaling factor for mass loads from the representation in - ! a restart file to the internal representation in this run. - real :: L_rescale ! A rescaling factor for horizontal lengths from the representation in - ! a restart file to the internal representation in this run. real :: meltrate_conversion ! The conversion factor to use for in the melt rate diagnostic. real :: dz_ocean_min_float ! The minimum ocean thickness above which the ice shelf is considered ! to be floating when CONST_SEA_LEVEL = True [Z ~> m]. @@ -1675,12 +1670,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, endif endif - call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., CS%restart_CSp, & - "Height unit conversion factor", "Z meter-1") - call register_restart_field(US%m_to_L_restart, "m_to_L", .false., CS%restart_CSp, & - "Length unit conversion factor", "L meter-1") - call register_restart_field(US%kg_m3_to_R_restart, "kg_m3_to_R", .false., CS%restart_CSp, & - "Density unit conversion factor", "R m3 kg-1") if (CS%active_shelf_dynamics) then call register_restart_field(ISS%hmask, "h_mask", .true., CS%restart_CSp, & "ice sheet/shelf thickness mask" ,"none") @@ -1723,28 +1712,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: Restoring ice shelf from file.") call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, G, CS%restart_CSp) - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= 1.0)) then - Z_rescale = 1.0 / US%m_to_Z_restart - do j=G%jsc,G%jec ; do i=G%isc,G%iec - ISS%h_shelf(i,j) = Z_rescale * ISS%h_shelf(i,j) - enddo ; enddo - endif - - if ((US%m_to_Z_restart*US%kg_m3_to_R_restart /= 0.0) .and. & - (US%m_to_Z_restart*US%kg_m3_to_R_restart /= 1.0)) then - RZ_rescale = 1.0 / (US%m_to_Z_restart * US%kg_m3_to_R_restart) - do j=G%jsc,G%jec ; do i=G%isc,G%iec - ISS%mass_shelf(i,j) = RZ_rescale * ISS%mass_shelf(i,j) - enddo ; enddo - endif - - if ((US%m_to_L_restart /= 0.0) .and. (US%m_to_L_restart /= 1.0)) then - L_rescale = 1.0 / US%m_to_L_restart - do j=G%jsc,G%jec ; do i=G%isc,G%iec - ISS%area_shelf_h(i,j) = L_rescale**2 * ISS%area_shelf_h(i,j) - enddo ; enddo - endif - endif ! .not. new_sim ! do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -1971,7 +1938,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) filename = trim(slasher(inputdir))//trim(shelf_file) call log_param(param_file, mdl, "INPUTDIR/SHELF_FILE", filename) - CS%id_read_mass = init_external_field(filename, shelf_mass_var, & + CS%mass_handle = init_external_field(filename, shelf_mass_var, & MOM_domain=CS%Grid_in%Domain, verbose=CS%debug) if (read_shelf_area) then @@ -1979,7 +1946,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) "The variable in SHELF_FILE with the shelf area.", & default="shelf_area") - CS%id_read_area = init_external_field(filename, shelf_area_var, & + CS%area_handle = init_external_field(filename, shelf_area_var, & MOM_domain=CS%Grid_in%Domain) endif @@ -2074,7 +2041,7 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) allocate(tmp2d(is:ie,js:je), source=0.0) endif - call time_interp_external(CS%id_read_mass, Time, tmp2d) + call time_interp_external(CS%mass_handle, Time, tmp2d) call rotate_array(tmp2d, CS%turns, ISS%mass_shelf) deallocate(tmp2d) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 3049cae00c..9b584ae0f9 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -330,10 +330,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ !! a solo ice-sheet driver. ! Local variables - real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a restart file to the internal representation in this run. - real :: vel_rescale ! A rescaling factor for horizontal velocities from the representation - ! in a restart file to the internal representation in this run. real :: T_shelf_bdry ! A default ice shelf temperature to use for ice flowing ! in through open boundaries [C ~> degC] !This include declares and sets the variable "version". @@ -485,21 +481,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! Take additional initialization steps, for example of dependent variables. if (active_shelf_dynamics .and. .not.new_sim) then - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= 1.0)) then - Z_rescale = 1.0 / US%m_to_Z_restart - do j=G%jsc,G%jec ; do i=G%isc,G%iec - CS%OD_av(i,j) = Z_rescale * CS%OD_av(i,j) - enddo ; enddo - endif - - if ((US%m_to_L_restart*US%s_to_T_restart /= 0.0) .and. & - (US%m_to_L_restart /= US%s_to_T_restart)) then - vel_rescale = US%s_to_T_restart / US%m_to_L_restart - do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec - CS%u_shelf(I,J) = vel_rescale * CS%u_shelf(I,J) - CS%v_shelf(I,J) = vel_rescale * CS%v_shelf(I,J) - enddo ; enddo - endif ! this is unfortunately necessary; if grid is not symmetric the boundary values ! of u and v are otherwise not set till the end of the first linear solve, and so diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 78f739c461..8af8cd3bc6 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -9,7 +9,7 @@ module MOM_coord_initialization use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type, log_version use MOM_io, only : create_MOM_file, file_exists -use MOM_io, only : MOM_infra_file, MOM_field +use MOM_io, only : MOM_netCDF_file, MOM_field use MOM_io, only : MOM_read_data, MOM_write_field, vardesc, var_desc, SINGLE_FILE use MOM_string_functions, only : slasher, uppercase use MOM_unit_scaling, only : unit_scale_type @@ -528,12 +528,12 @@ subroutine write_vertgrid_file(GV, US, param_file, directory) character(len=240) :: filepath type(vardesc) :: vars(2) type(MOM_field) :: fields(2) - type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset + type(MOM_netCDF_file) :: IO_handle ! The I/O handle of the fileset - filepath = trim(directory) // trim("Vertical_coordinate") + filepath = trim(directory) // trim("Vertical_coordinate.nc") vars(1) = var_desc("R","kilogram meter-3","Target Potential Density",'1','L','1') - vars(2) = var_desc("g","meter second-2","Reduced gravity",'1','L','1') + vars(2) = var_desc("g","meter second-2","Reduced gravity",'1','i','1') call create_MOM_file(IO_handle, trim(filepath), vars, 2, fields, & SINGLE_FILE, GV=GV) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index bd0931c694..0321d7511a 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -17,7 +17,7 @@ module MOM_state_initialization use MOM_file_parser, only : log_version use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type, isPointInCell -use MOM_interface_heights, only : find_eta +use MOM_interface_heights, only : find_eta, dz_to_thickness, dz_to_thickness_simple use MOM_io, only : file_exists, field_size, MOM_read_data, MOM_read_vector, slasher use MOM_open_boundary, only : ocean_OBC_type, open_boundary_init, set_tracer_data use MOM_open_boundary, only : OBC_NONE @@ -150,13 +150,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & optional, intent(in) :: mass_shelf !< The mass per unit area of the overlying !! ice shelf [ R Z ~> kg m-2 ] ! Local variables - real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] + real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] + real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! The layer thicknesses in geopotential (z) units [Z ~> m] character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config real :: H_rescale ! A rescaling factor for thicknesses from the representation in ! a restart file to the internal representation in this run [various units ~> 1] - real :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run [various units ~> 1] real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. logical :: from_Z_file, useALE @@ -226,6 +225,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !do k=1,nz ; do j=js,je ; do i=is,ie ! h(i,j,k) = 0. !enddo + + ! Initialize the layer thicknesses. + dz(:,:,:) = 0.0 endif ! Set the nominal depth of the ocean, which might be different from the bathymetric @@ -250,6 +252,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "salinities from a Z-space file on a latitude-longitude grid.", & default=.false., do_not_log=just_read) + convert = new_sim ! Thicknesses are initialized in height units in most cases. if (from_Z_file) then ! Initialize thickness and T/S from z-coordinate data in a file. if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//& @@ -257,14 +260,18 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, & just_read=just_read, frac_shelf_h=frac_shelf_h) + convert = .false. else ! Initialize thickness, h. call get_param(PF, mdl, "THICKNESS_CONFIG", config, & "A string that determines how the initial layer "//& "thicknesses are specified for a new run: \n"//& " \t file - read interface heights from the file specified \n"//& + " \t\t by (THICKNESS_FILE).\n"//& " \t thickness_file - read thicknesses from the file specified \n"//& " \t\t by (THICKNESS_FILE).\n"//& + " \t mass_file - read thicknesses in units of mass per unit area from the file \n"//& + " \t\t specified by (THICKNESS_FILE).\n"//& " \t coord - determined by ALE coordinate.\n"//& " \t uniform - uniform thickness layers evenly distributed \n"//& " \t\t between the surface and MAXIMUM_DEPTH. \n"//& @@ -289,51 +296,57 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & default="uniform", do_not_log=just_read) select case (trim(config)) case ("file") - call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .false., just_read=just_read) + call initialize_thickness_from_file(dz, depth_tot, G, GV, US, PF, file_has_thickness=.false., & + mass_file=.false., just_read=just_read) case ("thickness_file") - call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .true., just_read=just_read) + call initialize_thickness_from_file(dz, depth_tot, G, GV, US, PF, file_has_thickness=.true., & + mass_file=.false., just_read=just_read) + case ("mass_file") + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, file_has_thickness=.true., & + mass_file=.true., just_read=just_read) + convert = .false. case ("coord") if (new_sim .and. useALE) then - call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) + call ALE_initThicknessToCoord( ALE_CSp, G, GV, dz, height_units=.true. ) elseif (new_sim) then call MOM_error(FATAL, "MOM_initialize_state: USE_REGRIDDING must be True "//& "for THICKNESS_CONFIG of 'coord'") endif - case ("uniform"); call initialize_thickness_uniform(h, depth_tot, G, GV, PF, & + case ("uniform"); call initialize_thickness_uniform(dz, depth_tot, G, GV, PF, & just_read=just_read) - case ("list"); call initialize_thickness_list(h, depth_tot, G, GV, US, PF, & + case ("list"); call initialize_thickness_list(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("DOME"); call DOME_initialize_thickness(h, depth_tot, G, GV, PF, & + case ("DOME"); call DOME_initialize_thickness(dz, depth_tot, G, GV, PF, & just_read=just_read) - case ("ISOMIP"); call ISOMIP_initialize_thickness(h, depth_tot, G, GV, US, PF, tv, & + case ("ISOMIP"); call ISOMIP_initialize_thickness(dz, depth_tot, G, GV, US, PF, tv, & just_read=just_read) - case ("benchmark"); call benchmark_initialize_thickness(h, depth_tot, G, GV, US, PF, & + case ("benchmark"); call benchmark_initialize_thickness(dz, depth_tot, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref, just_read=just_read) - case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, & + case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(dz, depth_tot, & G, GV, US, PF, tv%P_Ref) case ("search"); call initialize_thickness_search() - case ("circle_obcs"); call circle_obcs_initialize_thickness(h, depth_tot, G, GV, PF, & + case ("circle_obcs"); call circle_obcs_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & + case ("lock_exchange"); call lock_exchange_initialize_thickness(dz, G, GV, US, & PF, just_read=just_read) - case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & + case ("external_gwave"); call external_gwave_initialize_thickness(dz, G, GV, US, & PF, just_read=just_read) - case ("DOME2D"); call DOME2d_initialize_thickness(h, depth_tot, G, GV, US, PF, & + case ("DOME2D"); call DOME2d_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & + case ("adjustment2d"); call adjustment_initialize_thickness(dz, G, GV, US, & PF, just_read=just_read) - case ("sloshing"); call sloshing_initialize_thickness(h, depth_tot, G, GV, US, PF, & + case ("sloshing"); call sloshing_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("seamount"); call seamount_initialize_thickness(h, depth_tot, G, GV, US, PF, & + case ("seamount"); call seamount_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("dumbbell"); call dumbbell_initialize_thickness(h, depth_tot, G, GV, US, PF, & + case ("dumbbell"); call dumbbell_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("soliton"); call soliton_initialize_thickness(h, depth_tot, G, GV, US) - case ("phillips"); call Phillips_initialize_thickness(h, depth_tot, G, GV, US, PF, & + case ("soliton"); call soliton_initialize_thickness(dz, depth_tot, G, GV, US) + case ("phillips"); call Phillips_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & + case ("rossby_front"); call Rossby_front_initialize_thickness(dz, G, GV, US, & PF, just_read=just_read) - case ("USER"); call user_initialize_thickness(h, G, GV, PF, & + case ("USER"); call user_initialize_thickness(dz, G, GV, PF, & just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized layer thickness configuration "//trim(config)) @@ -374,26 +387,26 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & G, GV, US, PF, just_read=just_read) case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, US, PF, & just_read=just_read) - case ("DOME2D"); call DOME2d_initialize_temperature_salinity (tv%T, tv%S, h, & + case ("DOME2D"); call DOME2d_initialize_temperature_salinity (tv%T, tv%S, dz, & G, GV, US, PF, just_read=just_read) - case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity (tv%T, tv%S, h, & + case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity (tv%T, tv%S, dz, & depth_tot, G, GV, US, PF, eos, just_read=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) + tv%S, dz, depth_tot, G, GV, US, PF, just_read=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) + tv%S, dz, depth_tot, G, GV, US, PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, US, PF, just_read=just_read) + tv%S, dz, G, GV, US, PF, just_read=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, US, PF, just_read=just_read) + tv%S, dz, G, GV, US, PF, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, US, PF, just_read=just_read) + tv%S, dz, G, GV, US, PF, just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, US, PF, just_read=just_read) - case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & + tv%S, dz, G, GV, US, PF, just_read=just_read) + case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, dz, & G, GV, US, PF, just_read=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, US, PF, tv%T, tv%S, & - h, just_read=just_read) + dz, just_read=just_read) case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, & just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& @@ -404,8 +417,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (use_temperature .and. use_OBC) & call fill_temp_salt_segments(G, GV, US, OBC, tv) - ! Calculate the initial surface displacement under ice shelf + ! Convert thicknesses from geometric distances in depth units to thickness units or mass-per-unit-area. + if (new_sim .and. convert) call dz_to_thickness(dz, tv, h, G, GV, US) + ! Handle the initial surface displacement under ice shelf call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & "If true, depress the initial surface to avoid huge "//& "tsunamis when a large surface pressure is applied.", & @@ -415,10 +430,43 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "at the depth where the hydrostatic pressure matches the imposed "//& "surface pressure which is read from file.", default=.false., & do_not_log=just_read) + if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& + "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") - if (new_sim) then - if (use_ice_shelf .and. present(mass_shelf) .and. .not. (trim_ic_for_p_surf .or. depress_sfc)) & - call calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & + call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_MKS) + + ! Remove the mass that would be displaced by an ice shelf or inverse barometer. + if (depress_sfc) then + call depress_surface(h, G, GV, US, PF, tv, just_read=just_read) + elseif (trim_ic_for_p_surf) then + call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read=just_read) + elseif (new_sim .and. use_ice_shelf .and. present(mass_shelf)) then + call calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + endif + + ! Perhaps we want to run the regridding coordinate generator for multiple + ! iterations here so the initial grid is consistent with the coordinate + if (useALE) then + call get_param(PF, mdl, "REGRID_ACCELERATE_INIT", regrid_accelerate, & + "If true, runs REGRID_ACCELERATE_ITERATIONS iterations of the regridding "//& + "algorithm to push the initial grid to be consistent with the initial "//& + "condition. Useful only for state-based and iterative coordinates.", & + default=.false., do_not_log=just_read) + if (regrid_accelerate) then + call get_param(PF, mdl, "REGRID_ACCELERATE_ITERATIONS", regrid_iterations, & + "The number of regridding iterations to perform to generate "//& + "an initial grid that is consistent with the initial conditions.", & + default=1, do_not_log=just_read) + + call get_param(PF, mdl, "DT", dt, "Timestep", & + units="s", scale=US%s_to_T, fail_if_missing=.true.) + + if (new_sim .and. debug) & + call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_MKS) + call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, OBC, tracer_Reg, & + dt=dt, initial=.true.) + endif endif ! The thicknesses in halo points might be needed to initialize the velocities. @@ -438,21 +486,15 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, & - just_read=just_read) - case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, & - just_read=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, & - just_read=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, & - just_read=just_read) - case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & - just_read=just_read) + case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, just_read) + case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, just_read) + case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, just_read) + case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, just_read) + case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & - G, GV, US, PF, just_read=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G, GV, US) - case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, & - just_read=just_read) + G, GV, US, PF, just_read) + case ("soliton"); call soliton_initialize_velocity(u, v, G, GV, US) + case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select @@ -462,49 +504,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) endif - ! Optionally convert the thicknesses from m to kg m-2. This is particularly - ! useful in a non-Boussinesq model. - call get_param(PF, mdl, "CONVERT_THICKNESS_UNITS", convert, & - "If true, convert the thickness initial conditions from "//& - "units of m to kg m-2 or vice versa, depending on whether "//& - "BOUSSINESQ is defined. This does not apply if a restart "//& - "file is read.", default=.not.GV%Boussinesq, do_not_log=just_read) - - if (new_sim .and. convert .and. .not.GV%Boussinesq) & - ! Convert thicknesses from geometric distances to mass-per-unit-area. - call convert_thickness(h, G, GV, US, tv) - - ! Remove the mass that would be displaced by an ice shelf or inverse barometer. - if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& - "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") - if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & - call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) - if (depress_sfc) call depress_surface(h, G, GV, US, PF, tv, just_read=just_read) - if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read=just_read) - - ! Perhaps we want to run the regridding coordinate generator for multiple - ! iterations here so the initial grid is consistent with the coordinate - if (useALE) then - call get_param(PF, mdl, "REGRID_ACCELERATE_INIT", regrid_accelerate, & - "If true, runs REGRID_ACCELERATE_ITERATIONS iterations of the regridding "//& - "algorithm to push the initial grid to be consistent with the initial "//& - "condition. Useful only for state-based and iterative coordinates.", & - default=.false., do_not_log=just_read) - if (regrid_accelerate) then - call get_param(PF, mdl, "REGRID_ACCELERATE_ITERATIONS", regrid_iterations, & - "The number of regridding iterations to perform to generate "//& - "an initial grid that is consistent with the initial conditions.", & - default=1, do_not_log=just_read) - - call get_param(PF, mdl, "DT", dt, "Timestep", & - units="s", scale=US%s_to_T, fail_if_missing=.true.) - - if (new_sim .and. debug) & - call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m) - call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, OBC, tracer_Reg, & - dt=dt, initial=.true.) - endif - endif + ! This is the end of the block of code that might have initialized fields + ! internally at the start of a new run. ! Initialized assimilative incremental update (oda_incupd) structure and ! register restart. @@ -517,9 +518,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call restart_registry_lock(restart_CS) endif - ! This is the end of the block of code that might have initialized fields - ! internally at the start of a new run. - if (.not.new_sim) then ! This block restores the state from a restart file. ! This line calls a subroutine that reads the initial conditions ! from a previously generated file. @@ -529,16 +527,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "MOM6 attempted to restart from a file from a different time than given by Time_in.") Time = Time_in endif - if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then - H_rescale = 1.0 / GV%m_to_H_restart - do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo - endif - if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%m_to_L_restart) ) then - vel_rescale = US%s_to_T_restart / US%m_to_L_restart - do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; u(I,j,k) = vel_rescale * u(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; v(i,J,k) = vel_rescale * v(i,J,k) ; enddo ; enddo ; enddo - endif endif if ( use_temperature ) then @@ -548,7 +536,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call pass_var(h, G%Domain) if (debug) then - call hchksum(h, "MOM_initialize_state: h ", G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(h, "MOM_initialize_state: h ", G%HI, haloshift=1, scale=GV%H_to_MKS) if ( use_temperature ) call hchksum(tv%T, "MOM_initialize_state: T ", G%HI, haloshift=1, scale=US%C_to_degC) if ( use_temperature ) call hchksum(tv%S, "MOM_initialize_state: S ", G%HI, haloshift=1, scale=US%S_to_ppt) if ( use_temperature .and. debug_layers) then ; do k=1,nz @@ -667,12 +655,14 @@ end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, file_has_thickness, & - just_read) + just_read, mass_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized, in height + !! or thickness units, depending on the value of + !! mass_file [Z ~> m] or [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -682,6 +672,8 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f !! interface heights. logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing h. + logical, intent(in) :: mass_file !< If true, this file contains layer thicknesses in + !! units of mass per unit area. ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. @@ -723,12 +715,17 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f "The variable name for layer thickness initial conditions.", & default="h", do_not_log=just_read) call get_param(param_file, mdl, "THICKNESS_IC_RESCALE", h_rescale, & - "A factor by which to rescale the initial thicknesses in the input "//& - "file to convert them to units of m.", & + 'A factor by which to rescale the initial thicknesses in the input file to '//& + 'convert them to units of kg/m2 (if THICKNESS_CONFIG="mass_file") or m.', & default=1.0, units="various", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, h_var, h(:,:,:), G%Domain, scale=h_rescale*GV%m_to_H) + if (mass_file) then + h_rescale = h_rescale*GV%kg_m2_to_H + else + h_rescale = h_rescale*US%m_to_Z + endif + call MOM_read_data(filename, h_var, h(:,:,:), G%Domain, scale=h_rescale) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the "//& @@ -763,9 +760,9 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta(i,j,K) - eta(i,j,K+1)) + h(i,j,k) = eta(i,j,K) - eta(i,j,K+1) endif enddo ; enddo ; enddo @@ -798,7 +795,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, ht, dZ_ref_eta) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [Z ~> m] real, intent(in) :: ht !< Tolerance to exceed adjustment !! criteria [Z ~> m] real, optional, intent(in) :: dZ_ref_eta !< The difference between the @@ -857,10 +854,6 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, ht, dZ_ref_eta) endif enddo ; enddo - ! Now convert thicknesses to units of H. - do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k)*GV%Z_to_H - enddo ; enddo ; enddo call sum_across_PEs(dilations) if ((dilations > 0) .and. (is_root_pe())) then @@ -876,7 +869,7 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -915,9 +908,9 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) endif enddo enddo ; enddo @@ -929,9 +922,9 @@ end subroutine initialize_thickness_uniform subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -990,9 +983,9 @@ subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_r eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) endif enddo enddo ; enddo @@ -1005,81 +998,6 @@ subroutine initialize_thickness_search call MOM_error(FATAL," MOM_state_initialization.F90, initialize_thickness_search: NOT IMPLEMENTED") end subroutine initialize_thickness_search -!> Converts thickness from geometric to pressure units -subroutine convert_thickness(h, G, GV, US, tv) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Input geometric layer thicknesses being converted - !! to layer pressure [H ~> m or kg m-2]. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables - ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: & - p_top, p_bot ! Pressure at the interfaces above and below a layer [R L2 T-2 ~> Pa] - real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height across a layer [L2 T-2 ~> m2 s-2] - real :: rho(SZI_(G)) ! The in situ density [R ~> kg m-3] - real :: I_gEarth ! Unit conversion factors divided by the gravitational acceleration - ! [H T2 R-1 L-2 ~> s2 m2 kg-1 or s2 m-1] - real :: HR_to_pres ! A conversion factor from the input geometric thicknesses times the layer - ! densities into pressure units [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: itt, max_itt - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - max_itt = 10 - - if (GV%Boussinesq) then - call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") - else - I_gEarth = GV%RZ_to_H / GV%g_Earth - HR_to_pres = GV%g_Earth * GV%H_to_Z - - if (associated(tv%eqn_of_state)) then - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - p_bot(i,j) = 0.0 ; p_top(i,j) = 0.0 - enddo ; enddo - EOSdom(:) = EOS_domain(G%HI) - do k=1,nz - do j=js,je - do i=is,ie ; p_top(i,j) = p_bot(i,j) ; enddo - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_top(:,j), rho, & - tv%eqn_of_state, EOSdom) - do i=is,ie - p_bot(i,j) = p_top(i,j) + HR_to_pres * (h(i,j,k) * rho(i)) - enddo - enddo - - do itt=1,max_itt - call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p_top, p_bot, 0.0, G%HI, & - tv%eqn_of_state, US, dz_geo) - if (itt < max_itt) then ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_bot(:,j), rho, & - tv%eqn_of_state, EOSdom) - ! Use Newton's method to correct the bottom value. - ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. - do i=is,ie - p_bot(i,j) = p_bot(i,j) + rho(i) * (HR_to_pres*h(i,j,k) - dz_geo(i,j)) - enddo - enddo ; endif - enddo - - do j=js,je ; do i=is,ie - h(i,j,k) = (p_bot(i,j) - p_top(i,j)) * I_gEarth - enddo ; enddo - enddo - else - do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) * (GV%Rlay(k) / GV%Rho0) - enddo ; enddo ; enddo - endif - endif - -end subroutine convert_thickness - !> Depress the sea-surface based on an initial condition file subroutine depress_surface(h, G, GV, US, param_file, tv, just_read, z_top_shelf) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -1195,7 +1113,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) ! of temperature within each layer [C ~> degC] character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor ! A file-dependent scaling factor for the input pressure [various]. - real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. + real :: min_thickness ! The minimum layer thickness [H ~> m or kg m-2]. real :: z_tolerance ! The tolerance with which to find the depth matching a specified pressure [Z ~> m]. integer :: i, j, k integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. @@ -1225,7 +1143,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3, scale=US%m_to_Z, do_not_log=just_read) + units='m', default=1.e-3, scale=GV%m_to_H, do_not_log=just_read) call get_param(PF, mdl, "TRIM_IC_Z_TOLERANCE", z_tolerance, & "The tolerance with which to find the depth matching the specified "//& "surface pressure with TRIM_IC_FOR_P_SURF.", & @@ -1262,7 +1180,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) if (just_read) return ! All run-time parameters have been read, so return. call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, & - scale=scale_factor*US%kg_m3_to_R*US%m_s_to_L_T**2) + scale=scale_factor*US%Pa_to_RL2_T2) if (use_remapping) then allocate(remap_CS) @@ -1382,7 +1300,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: G_earth !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: depth !< Depth of ocean column [Z ~> m]. - real, intent(in) :: min_thickness !< Smallest thickness allowed [Z ~> m]. + real, intent(in) :: min_thickness !< Smallest thickness allowed [H ~> m or kg m-2]. real, dimension(nk), intent(inout) :: T !< Layer mean temperature [C ~> degC] real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer [C ~> degC] real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer [C ~> degC] @@ -1405,51 +1323,75 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, real, dimension(nk) :: h0, h1 ! Initial and remapped layer thicknesses [H ~> m or kg m-2] real, dimension(nk) :: S0, S1 ! Initial and remapped layer salinities [S ~> ppt] real, dimension(nk) :: T0, T1 ! Initial and remapped layer temperatures [C ~> degC] - real :: P_t, P_b ! Top and bottom pressures [R L2 T-2 ~> Pa] + real :: P_t, P_b ! Top and bottom pressures [R L2 T-2 ~> Pa] real :: z_out, e_top ! Interface height positions [Z ~> m] + real :: min_dz ! The minimum thickness in depth units [Z ~> m] + real :: dh_surf_rem ! The remaining thickness to remove in non-Bousinesq mode [H ~> kg m-2] logical :: answers_2018 integer :: k answers_2018 = .true. ; if (present(remap_answer_date)) answers_2018 = (remap_answer_date < 20190101) - ! Calculate original interface positions - e(nk+1) = -depth - do k=nk,1,-1 - e(K) = e(K+1) + GV%H_to_Z*h(k) - h0(k) = h(nk+1-k) ! Keep a copy to use in remapping - enddo + ! Keep a copy of the initial thicknesses in reverse order to use in remapping + do k=1,nk ; h0(k) = h(nk+1-k) ; enddo - P_t = 0. - e_top = e(1) - do k=1,nk - call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & - US, P_b, z_out, z_tol=z_tol) - if (z_out>=e(K)) then - ! Imposed pressure was less that pressure at top of cell - exit - elseif (z_out<=e(K+1)) then - ! Imposed pressure was greater than pressure at bottom of cell - e_top = e(K+1) - else - ! Imposed pressure was fell between pressures at top and bottom of cell - e_top = z_out - exit - endif - P_t = P_b - enddo - if (e_top e_top) then - ! Original e(K) is too high - e(K) = e_top - e_top = e_top - min_thickness ! Next interface must be at least this deep + if (GV%Boussinesq) then + min_dz = GV%H_to_Z * min_thickness + ! Calculate original interface positions + e(nk+1) = -depth + do k=nk,1,-1 + e(K) = e(K+1) + GV%H_to_Z*h(k) + enddo + + P_t = 0. + e_top = e(1) + do k=1,nk + call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & + US, P_b, z_out, z_tol=z_tol) + if (z_out>=e(K)) then + ! Imposed pressure was less that pressure at top of cell + exit + elseif (z_out<=e(K+1)) then + ! Imposed pressure was greater than pressure at bottom of cell + e_top = e(K+1) + else + ! Imposed pressure was fell between pressures at top and bottom of cell + e_top = z_out + exit endif - ! This layer needs trimming - h(k) = GV%Z_to_H * max( min_thickness, e(K) - e(K+1) ) - if (e(K) < e_top) exit ! No need to go further + P_t = P_b enddo + if (e_top e_top) then + ! Original e(K) is too high + e(K) = e_top + e_top = e_top - min_dz ! Next interface must be at least this deep + endif + ! This layer needs trimming + h(k) = max( min_thickness, GV%Z_to_H * (e(K) - e(K+1)) ) + if (e(K) < e_top) exit ! No need to go further + enddo + endif + else + ! In non-Bousinesq mode, we are already in mass units so the calculation is much easier. + if (p_surf > 0.0) then + dh_surf_rem = p_surf * GV%RZ_to_H / G_earth + do k=1,nk + if (h(k) <= min_thickness) then ! This layer has no mass to remove. + cycle + elseif ((h(k) - min_thickness) < dh_surf_rem) then ! This layer should be removed entirely. + dh_surf_rem = dh_surf_rem - (h(k) - min_thickness) + h(k) = min_thickness + else ! This is the last layer that should be removed. + h(k) = h(k) - dh_surf_rem + dh_surf_rem = 0.0 + exit + endif + enddo + endif endif ! Now we need to remap but remapping assumes the surface is at the @@ -1937,6 +1879,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t !! overrides any value set for Time. ! Local variables real, allocatable, dimension(:,:,:) :: eta ! The target interface heights [Z ~> m]. + real, allocatable, dimension(:,:,:) :: dz ! The target interface thicknesses in height units [Z ~> m] real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses [H ~> m or kg m-2]. real, dimension (SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1944,9 +1887,10 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t tmp2 ! A temporary array for salinities [S ~> ppt] real, dimension (SZI_(G),SZJ_(G)) :: & tmp_2d ! A temporary array for mixed layer densities [R ~> kg m-3] - real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge target fields - ! on the vertical grid of the input file, used for both - ! temperatures [C ~> degC] and salinities [S ~> ppt] + real, allocatable, dimension(:,:,:) :: tmp_T ! A temporary array for reading sponge target temperatures + ! on the vertical grid of the input file [C ~> degC] + real, allocatable, dimension(:,:,:) :: tmp_S ! A temporary array for reading sponge target salinities + ! on the vertical grid of the input file [S ~> ppt] real, allocatable, dimension(:,:,:) :: tmp_u ! Temporary array for reading sponge target zonal ! velocities on the vertical grid of the input file [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:) :: tmp_v ! Temporary array for reading sponge target meridional @@ -1967,6 +1911,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t character(len=40) :: mdl = "initialize_sponges_file" character(len=200) :: damping_file, uv_damping_file, state_file, state_uv_file ! Strings for filenames character(len=200) :: filename, inputdir ! Strings for file/path and path. + type(verticalGrid_type) :: GV_loc ! A temporary vertical grid structure logical :: use_ALE ! True if ALE is being used, False if in layered mode logical :: time_space_interp_sponge ! If true use sponge data that need to be interpolated in both @@ -2139,35 +2084,51 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t call MOM_error(FATAL,"initialize_sponge_file: Array size mismatch for sponge data.") nz_data = siz(3)-1 allocate(eta(isd:ied,jsd:jed,nz_data+1)) - allocate(h(isd:ied,jsd:jed,nz_data)) + allocate(dz(isd:ied,jsd:jed,nz_data)) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -depth_tot(i,j) + eta(i,j,nz_data+1) = -depth_tot(i,j) enddo ; enddo - do k=nz,1,-1 ; do j=js,je ; do i=is,ie + do k=nz_data,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo - do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = GV%Z_to_H*(eta(i,j,k)-eta(i,j,k+1)) + do k=1,nz_data ; do j=js,je ; do i=is,ie + dz(i,j,k) = eta(i,j,k)-eta(i,j,k+1) enddo; enddo ; enddo + deallocate(eta) + + allocate(h(isd:ied,jsd:jed,nz_data)) + if (use_temperature) then + allocate(tmp_T(isd:ied,jsd:jed,nz_data)) + allocate(tmp_S(isd:ied,jsd:jed,nz_data)) + call MOM_read_data(filename, potemp_var, tmp_T(:,:,:), G%Domain, scale=US%degC_to_C) + call MOM_read_data(filename, salin_var, tmp_S(:,:,:), G%Domain, scale=US%ppt_to_S) + endif + + GV_loc = GV ; GV_loc%ke = nz_data + if (use_temperature .and. associated(tv%eqn_of_state)) then + call dz_to_thickness(dz, tmp_T, tmp_S, tv%eqn_of_state, h, G, GV_loc, US) + else + call dz_to_thickness_simple(dz, h, G, GV_loc, US, layer_mode=.true.) + endif + if (sponge_uv) then call initialize_ALE_sponge(Idamp, G, GV, param_file, ALE_CSp, h, nz_data, Idamp_u, Idamp_v) else call initialize_ALE_sponge(Idamp, G, GV, param_file, ALE_CSp, h, nz_data) endif - deallocate(eta) - deallocate(h) if (use_temperature) then - allocate(tmp_tr(isd:ied,jsd:jed,nz_data)) - call MOM_read_data(filename, potemp_var, tmp_tr(:,:,:), G%Domain, scale=US%degC_to_C) - call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%T, ALE_CSp, 'temp', & + call set_up_ALE_sponge_field(tmp_T, G, GV, tv%T, ALE_CSp, 'temp', & sp_long_name='temperature', sp_unit='degC s-1') - call MOM_read_data(filename, salin_var, tmp_tr(:,:,:), G%Domain, scale=US%ppt_to_S) - call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%S, ALE_CSp, 'salt', & + call set_up_ALE_sponge_field(tmp_S, G, GV, tv%S, ALE_CSp, 'salt', & sp_long_name='salinity', sp_unit='g kg-1 s-1') - deallocate(tmp_tr) + deallocate(tmp_S) + deallocate(tmp_T) endif + deallocate(h) + deallocate(dz) + if (sponge_uv) then filename = trim(inputdir)//trim(state_uv_file) call log_param(param_file, mdl, "INPUTDIR/SPONGE_STATE_UV_FILE", filename) @@ -2503,7 +2464,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real, dimension(:,:,:), allocatable, target :: salt_z ! Input salinities [S ~> ppt] real, dimension(:,:,:), allocatable, target :: mask_z ! 1 for valid data points [nondim] real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zi ! Interface heights [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zi ! Interface heights [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Layer thicknesses in height units [Z ~> m] real, dimension(SZI_(G),SZJ_(G)) :: Z_bottom ! The (usually negative) height of the seafloor ! relative to the surface [Z ~> m]. integer, dimension(SZI_(G),SZJ_(G)) :: nlevs ! The number of levels in each column with valid data @@ -2514,7 +2476,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real, dimension(:,:,:), allocatable, target :: tmpT1dIn ! Input temperatures on a model-sized grid [C ~> degC] real, dimension(:,:,:), allocatable, target :: tmpS1dIn ! Input salinities on a model-sized grid [S ~> ppt] real, dimension(:,:,:), allocatable :: tmp_mask_in ! The valid data mask on a model-sized grid [nondim] - real, dimension(:,:,:), allocatable :: h1 ! Thicknesses [H ~> m or kg m-2]. + real, dimension(:,:,:), allocatable :: dz1 ! Input grid thicknesses in depth units [Z ~> m] + real, dimension(:,:,:), allocatable :: h1 ! Thicknesses on the input grid [H ~> m or kg m-2]. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to ! regridding [H ~> m or kg m-2] real :: zTopOfCell, zBottomOfCell ! Heights in Z units [Z ~> m]. @@ -2721,7 +2684,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just if ((.not.useALEremapping) .and. adjust_temperature) & ! This call is just here to read and log the determine_temperature parameters call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), eos, tv%P_Ref, 0, & - h, 0, G, GV, US, PF, just_read=.true.) + 0, G, GV, US, PF, just_read=.true.) call cpu_clock_end(id_clock_routine) return ! All run-time parameters have been read, so return. endif @@ -2773,6 +2736,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! Build the source grid and copy data onto model-shaped arrays with vanished layers allocate( tmp_mask_in(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( dz1(isd:ied,jsd:jed,nkd), source=0.0 ) allocate( h1(isd:ied,jsd:jed,nkd), source=0.0 ) allocate( tmpT1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) allocate( tmpS1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) @@ -2793,63 +2757,71 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just tmpT1dIn(i,j,k) = temp_land_fill tmpS1dIn(i,j,k) = salt_land_fill endif - h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) + dz1(i,j,k) = (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell - Z_bottom(i,j) ) + dz1(i,j,kd) = dz1(i,j,kd) + max(0., zTopOfCell - Z_bottom(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo deallocate( tmp_mask_in ) + ! Convert input thicknesses to units of H. In non-Boussinesq mode this is done by inverting + ! integrals of specific volume in pressure, so it can be expensive. + tv_loc = tv + tv_loc%T => tmpT1dIn + tv_loc%S => tmpS1dIn + GV_loc = GV + GV_loc%ke = nkd + call dz_to_thickness(dz1, tv_loc, h1, G, GV_loc, US) + ! Build the target grid (and set the model thickness to it) - ! This call can be more general but is hard-coded for z* coordinates... ???? + call ALE_initRegridding( GV, US, G%max_depth, PF, mdl, regridCS ) ! sets regridCS + call initialize_remapping( remapCS, remappingScheme, boundary_extrapolation=.false., answer_date=remap_answer_date ) + + ! Now remap from source grid to target grid, first setting reconstruction parameters + if (remap_general) then + call set_regrid_params( regridCS, min_thickness=0. ) + allocate( dz_interface(isd:ied,jsd:jed,nkd+1) ) ! Need for argument to regridding_main() but is not used + + call regridding_preadjust_reqs(regridCS, do_conv_adj, ignore) + if (do_conv_adj) call convective_adjustment(G, GV_loc, h1, tv_loc) + call regridding_main( remapCS, regridCS, G, GV_loc, h1, tv_loc, h, dz_interface, & + frac_shelf_h=frac_shelf_h ) - if (.not. remap_general) then + deallocate( dz_interface ) + else ! This is the old way of initializing to z* coordinates only allocate( hTarget(nz) ) hTarget = getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie - h(i,j,:) = 0. + dz(i,j,:) = 0. if (G%mask2dT(i,j) > 0.) then ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz zBottomOfCell = max( zTopOfCell - hTarget(k), Z_bottom(i,j)) - h(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) + dz(i,j,k) = zTopOfCell - zBottomOfCell zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo else - h(i,j,:) = 0. + dz(i,j,:) = 0. endif ! mask2dT enddo ; enddo deallocate( hTarget ) - endif - ! Now remap from source grid to target grid, first setting reconstruction parameters - call initialize_remapping( remapCS, remappingScheme, boundary_extrapolation=.false., answer_date=remap_answer_date ) - if (remap_general) then - call set_regrid_params( regridCS, min_thickness=0. ) - tv_loc = tv - tv_loc%T => tmpT1dIn - tv_loc%S => tmpS1dIn - GV_loc = GV - GV_loc%ke = nkd - allocate( dz_interface(isd:ied,jsd:jed,nkd+1) ) ! Need for argument to regridding_main() but is not used - - call regridding_preadjust_reqs(regridCS, do_conv_adj, ignore) - if (do_conv_adj) call convective_adjustment(G, GV_loc, h1, tv_loc) - call regridding_main( remapCS, regridCS, G, GV_loc, h1, tv_loc, h, dz_interface, & - frac_shelf_h=frac_shelf_h ) - - deallocate( dz_interface ) + ! This is a simple conversion of the target grid to thickness units that may not be + ! appropriate in non-Boussinesq mode. + call dz_to_thickness_simple(dz, h, G, GV, US) endif + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, & old_remap=remap_old_alg, answer_date=remap_answer_date ) call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & old_remap=remap_old_alg, answer_date=remap_answer_date ) + deallocate( dz1 ) deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) @@ -2886,15 +2858,16 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just deallocate(rho_z) + dz(:,:,:) = 0.0 if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, zi, h, h_tolerance, dZ_ref_eta=G%Z_ref) + call adjustEtaToFitBathymetry(G, GV, US, zi, dz, h_tolerance, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + dz(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1)) + dz(i,j,k) = zi(i,j,K) - zi(i,j,K+1) endif enddo ; enddo ; enddo inconsistent = 0 @@ -2926,9 +2899,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! Finally adjust to target density ks = 1 ; if (separate_mixed_layer) ks = GV%nk_rho_varies + 1 call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), eos, tv%P_Ref, niter, & - h, ks, G, GV, US, PF, just_read) + ks, G, GV, US, PF, just_read) endif + ! Now convert thicknesses to units of H. + call dz_to_thickness(dz, tv, h, G, GV, US) + endif ! useALEremapping deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) @@ -3136,7 +3112,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) GV%H_to_m*h(:) - call cut_off_column_top(nk, tv, GV, US, GV%g_Earth, -e(nk+1), GV%Angstrom_Z, & + call cut_off_column_top(nk, tv, GV, US, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS, z_tol=z_tol) write(0,*) GV%H_to_m*h(:) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index bd77ec54d5..64f6673371 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -12,6 +12,7 @@ module MOM_tracer_initialization_from_Z use MOM_file_parser, only : get_param, param_file_type, log_version use MOM_grid, only : ocean_grid_type use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer +use MOM_interface_heights, only : dz_to_thickness_simple use MOM_remapping, only : remapping_CS, initialize_remapping use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type @@ -75,10 +76,12 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ real, allocatable, dimension(:), target :: z_in ! Cell center depths for input data [Z ~> m] ! Local variables for ALE remapping - real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses [H ~> m or kg m-2]. + real, dimension(:,:,:), allocatable :: dzSrc ! Source thicknesses in height units [Z ~> m] + real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses [H ~> m or kg m-2] real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses [Z ~> m]. real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays + type(verticalGrid_type) :: GV_loc ! A temporary vertical grid structure real :: missing_value ! A value indicating that there is no valid input data at this point [CU ~> conc] integer :: nPoints ! The number of valid input data points in a column @@ -180,6 +183,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ call cpu_clock_begin(id_clock_ALE) ! First we reserve a work space for reconstructions of the source data allocate( h1(kd) ) + allocate( dzSrc(isd:ied,jsd:jed,kd) ) allocate( hSrc(isd:ied,jsd:jed,kd) ) ! Set parameters for reconstructions call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false., answer_date=remap_answer_date ) @@ -204,12 +208,18 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ else tr(i,j,:) = 0. endif ! mask2dT - hSrc(i,j,:) = GV%Z_to_H * h1(:) + dzSrc(i,j,:) = h1(:) enddo ; enddo + ! Equation of state data is not available, so a simpler rescaling will have to suffice, + ! but it might be problematic in non-Boussinesq mode. + GV_loc = GV ; GV_loc%ke = kd + call dz_to_thickness_simple(dzSrc, hSrc, G, GV_loc, US) + call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false., answer_date=remap_answer_date ) deallocate( hSrc ) + deallocate( dzSrc ) deallocate( h1 ) do k=1,nz diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 8a1aab3328..53615b0063 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -17,6 +17,7 @@ module MOM_oda_driver_mod use MOM_io, only : SINGLE_FILE use MOM_interp_infra, only : init_extern_field, get_external_field_info use MOM_interp_infra, only : time_interp_extern +use MOM_interpolate, only : external_field use MOM_remapping, only : remappingSchemesDoc use MOM_time_manager, only : time_type, real_to_time, get_date use MOM_time_manager, only : operator(+), operator(>=), operator(/=) @@ -80,8 +81,8 @@ module MOM_oda_driver_mod !> A structure containing integer handles for bias adjustment of tracers type :: INC_CS integer :: fldno = 0 !< The number of tracers - integer :: T_id !< The integer handle for the temperature file - integer :: S_id !< The integer handle for the salinity file + type(external_field) :: T !< The handle for the temperature file + type(external_field) :: S !< The handle for the salinity file end type INC_CS !> Control structure that contains a transpose of the ocean state across ensemble members. @@ -391,11 +392,11 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) "tendency adjustments", default='temp_salt_adjustment.nc') inc_file = trim(inputdir) // trim(bias_correction_file) - CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + CS%INC_CS%T = init_extern_field(inc_file, "temp_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + CS%INC_CS%S = init_extern_field(inc_file, "salt_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + call get_external_field_info(CS%INC_CS%T, size=fld_sz) CS%INC_CS%fldno = 2 if (CS%nk /= fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') @@ -578,9 +579,9 @@ subroutine get_bias_correction_tracer(Time, US, CS) call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id, Time, CS%G, T_bias, & + call horiz_interp_and_extrap_tracer(CS%INC_CS%T, Time, CS%G, T_bias, & valid_flag, z_in, z_edges_in, missing_value, scale=US%degC_to_C*US%s_to_T, spongeOngrid=.true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id, Time, CS%G, S_bias, & + call horiz_interp_and_extrap_tracer(CS%INC_CS%S, Time, CS%G, S_bias, & valid_flag, z_in, z_edges_in, missing_value, scale=US%ppt_to_S*US%s_to_T, spongeOngrid=.true.) ! This should be replaced to use mask_z instead of the following lines diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index add2d6a984..6a439dfd22 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -21,6 +21,7 @@ module MOM_MEKE use MOM_interface_heights, only : find_eta use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init +use MOM_interpolate, only : external_field use MOM_io, only : vardesc, var_desc, slasher use MOM_isopycnal_slopes, only : calc_isoneutral_slopes use MOM_restart, only : MOM_restart_CS, register_restart_field, query_initialized @@ -129,7 +130,7 @@ module MOM_MEKE integer :: id_Lrhines = -1, id_Leady = -1 integer :: id_MEKE_equilibrium = -1 !>@} - integer :: id_eke = -1 !< Handle for reading in EKE from a file + type(external_field) :: eke_handle !< Handle for reading in EKE from a file ! Infrastructure integer :: id_clock_pass !< Clock for group pass calls type(group_pass_type) :: pass_MEKE !< Group halo pass handle for MEKE%MEKE and maybe MEKE%Kh_diff @@ -627,7 +628,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif case(EKE_FILE) - call time_interp_external(CS%id_eke, Time, data_eke, scale=US%m_s_to_L_T**2) + call time_interp_external(CS%eke_handle, Time, data_eke, scale=US%m_s_to_L_T**2) do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = data_eke(i,j) * G%mask2dT(i,j) enddo; enddo @@ -1101,10 +1102,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, !! otherwise in tracer dynamics ! Local variables - real :: I_T_rescale ! A rescaling factor for time from the internal representation in this - ! run to the representation in a restart file, [nondim]? - real :: L_rescale ! A rescaling factor for length from the internal representation in this - ! run to the representation in a restart file, [nondim]? real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value [T ~> s] real :: cdrag ! The default bottom drag coefficient [nondim]. character(len=200) :: eke_filename, eke_varname, inputdir @@ -1157,7 +1154,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, inputdir = slasher(inputdir) eke_filename = trim(inputdir) // trim(eke_filename) - CS%id_eke = init_external_field(eke_filename, eke_varname, domain=G%Domain%mpp_domain) + CS%eke_handle = init_external_field(eke_filename, eke_varname, domain=G%Domain%mpp_domain) case("prog") CS%eke_src = EKE_PROG ! Read all relevant parameters and write them to the model log. @@ -1439,47 +1436,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, if (CS%initialize) call MOM_error(WARNING, & "MEKE_init: Initializing MEKE with a local equilibrium balance.") - ! Account for possible changes in dimensional scaling for variables that have been - ! read from a restart file. - I_T_rescale = 1.0 - if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= 1.0)) & - I_T_rescale = US%s_to_T_restart - L_rescale = 1.0 - if ((US%m_to_L_restart /= 0.0) .and. (US%m_to_L_restart /= 1.0)) & - L_rescale = 1.0 / US%m_to_L_restart - - if (L_rescale*I_T_rescale /= 1.0) then - if (allocated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then - do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (L_rescale*I_T_rescale)**2 * MEKE%MEKE(i,j) - enddo ; enddo - endif ; endif - endif - if (L_rescale**2*I_T_rescale /= 1.0) then - if (allocated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then - do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh(i,j) - enddo ; enddo - endif ; endif - if (allocated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then - do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = L_rescale**2*I_T_rescale * MEKE%Ku(i,j) - enddo ; enddo - endif ; endif - if (allocated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then - do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh_diff(i,j) - enddo ; enddo - endif ; endif - endif - if (L_rescale**4*I_T_rescale /= 1.0) then - if (allocated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then - do j=js,je ; do i=is,ie - MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) - enddo ; enddo - endif ; endif - endif - ! Set up group passes. In the case of a restart, these fields need a halo update now. if (allocated(MEKE%MEKE)) then call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) diff --git a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 new file mode 100644 index 0000000000..500e4a508c --- /dev/null +++ b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 @@ -0,0 +1,978 @@ +! > Calculates Zanna and Bolton 2020 parameterization +module MOM_Zanna_Bolton + +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_diag_mediator, only : diag_ctrl, time_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_diag_mediator, only : post_data, register_diag_field +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : To_North, To_East +use MOM_domains, only : pass_var, CORNER +use MOM_coms, only : reproducing_sum, max_across_PEs, min_across_PEs +use MOM_error_handler, only : MOM_error, WARNING + +implicit none ; private + +#include + +public Zanna_Bolton_2020, ZB_2020_init + +!> Control structure for Zanna-Bolton-2020 parameterization. +type, public :: ZB2020_CS ; private + ! Parameters + real :: amplitude !< The nondimensional scaling factor in ZB model, + !! typically 0.1 - 10 [nondim]. + integer :: ZB_type !< Select how to compute the trace part of ZB model: + !! 0 - both deviatoric and trace components are computed + !! 1 - only deviatoric component is computed + !! 2 - only trace component is computed + integer :: ZB_cons !< Select a discretization scheme for ZB model + !! 0 - non-conservative scheme + !! 1 - conservative scheme for deviatoric component + integer :: LPF_iter !< Number of smoothing passes for the Velocity Gradient (VG) components + !! in ZB model. + integer :: LPF_order !< The scale selectivity of the smoothing filter + !! 1 - Laplacian filter + !! 2 - Bilaplacian filter + integer :: HPF_iter !< Number of sharpening passes for the Velocity Gradient (VG) components + !! in ZB model. + integer :: HPF_order !< The scale selectivity of the sharpening filter + !! 1 - Laplacian filter + !! 2 - Bilaplacian filter + integer :: Stress_iter !< Number of smoothing passes for the Stress tensor components + !! in ZB model. + integer :: Stress_order !< The scale selectivity of the smoothing filter + !! 1 - Laplacian filter + !! 2 - Bilaplacian filter + integer :: ssd_iter !< Hyperviscosity parameter. Defines the number of sharpening passes + !! in Laplacian viscosity model: + !! -1: hyperviscosity is off + !! 0: Laplacian viscosity + !! 9: (Laplacian)^10 viscosity, ... + real :: ssd_bound_coef !< The non-dimensional damping coefficient of the grid harmonic + !! by hyperviscous dissipation: + !! 0.0: no damping + !! 1.0: grid harmonic is removed after a step in time + real :: DT !< The (baroclinic) dynamics time step [T ~> s] + + type(diag_ctrl), pointer :: diag => NULL() !< A type that regulates diagnostics output + !>@{ Diagnostic handles + integer :: id_ZB2020u = -1, id_ZB2020v = -1, id_KE_ZB2020 = -1 + integer :: id_maskT = -1 + integer :: id_maskq = -1 + integer :: id_S_11 = -1 + integer :: id_S_22 = -1 + integer :: id_S_12 = -1 + !>@} + +end type ZB2020_CS + +contains + +!> Read parameters and register output fields +!! used in Zanna_Bolton_2020(). +subroutine ZB_2020_init(Time, GV, US, param_file, diag, CS, use_ZB2020) + type(time_type), intent(in) :: Time !< The current model time. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. + type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure. + logical, intent(out) :: use_ZB2020 !< If true, turns on ZB scheme. + + ! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "MOM_Zanna_Bolton" ! This module's name. + + call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "USE_ZB2020", use_ZB2020, & + "If true, turns on Zanna-Bolton-2020 (ZB) " //& + "subgrid momentum parameterization of mesoscale eddies.", default=.false.) + if (.not. use_ZB2020) return + + call get_param(param_file, mdl, "ZB_SCALING", CS%amplitude, & + "The nondimensional scaling factor in ZB model, " //& + "typically 0.1 - 10.", units="nondim", default=0.3) + + call get_param(param_file, mdl, "ZB_TRACE_MODE", CS%ZB_type, & + "Select how to compute the trace part of ZB model:\n" //& + "\t 0 - both deviatoric and trace components are computed\n" //& + "\t 1 - only deviatoric component is computed\n" //& + "\t 2 - only trace component is computed", default=0) + + call get_param(param_file, mdl, "ZB_SCHEME", CS%ZB_cons, & + "Select a discretization scheme for ZB model:\n" //& + "\t 0 - non-conservative scheme\n" //& + "\t 1 - conservative scheme for deviatoric component", default=1) + + call get_param(param_file, mdl, "VG_SMOOTH_PASS", CS%LPF_iter, & + "Number of smoothing passes for the Velocity Gradient (VG) components " //& + "in ZB model.", default=0) + + call get_param(param_file, mdl, "VG_SMOOTH_SEL", CS%LPF_order, & + "The scale selectivity of the smoothing filter " //& + "for VG components:\n" //& + "\t 1 - Laplacian filter\n" //& + "\t 2 - Bilaplacian filter, ...", & + default=1, do_not_log = CS%LPF_iter==0) + + call get_param(param_file, mdl, "VG_SHARP_PASS", CS%HPF_iter, & + "Number of sharpening passes for the Velocity Gradient (VG) components " //& + "in ZB model.", default=0) + + call get_param(param_file, mdl, "VG_SHARP_SEL", CS%HPF_order, & + "The scale selectivity of the sharpening filter " //& + "for VG components:\n" //& + "\t 1 - Laplacian filter\n" //& + "\t 2 - Bilaplacian filter,...", & + default=1, do_not_log = CS%HPF_iter==0) + + call get_param(param_file, mdl, "STRESS_SMOOTH_PASS", CS%Stress_iter, & + "Number of smoothing passes for the Stress tensor components " //& + "in ZB model.", default=0) + + call get_param(param_file, mdl, "STRESS_SMOOTH_SEL", CS%Stress_order, & + "The scale selectivity of the smoothing filter " //& + "for the Stress tensor components:\n" //& + "\t 1 - Laplacian filter\n" //& + "\t 2 - Bilaplacian filter,...", & + default=1, do_not_log = CS%Stress_iter==0) + + call get_param(param_file, mdl, "ZB_HYPERVISC", CS%ssd_iter, & + "Select an additional hyperviscosity to stabilize the ZB model:\n" //& + "\t 0 - off\n" //& + "\t 1 - Laplacian viscosity\n" //& + "\t 10 - (Laplacian)**10 viscosity, ...", & + default=0) + ! Convert to the number of sharpening passes + ! applied to the Laplacian viscosity model + CS%ssd_iter = CS%ssd_iter-1 + + call get_param(param_file, mdl, "HYPVISC_GRID_DAMP", CS%ssd_bound_coef, & + "The non-dimensional damping coefficient of the grid harmonic " //& + "by hyperviscous dissipation:\n" //& + "\t 0.0 - no damping\n" //& + "\t 1.0 - grid harmonic is removed after a step in time", & + units="nondim", default=0.2, do_not_log = CS%ssd_iter==-1) + + call get_param(param_file, mdl, "DT", CS%dt, & + "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, & + fail_if_missing=.true.) + + ! Register fields for output from this module. + CS%diag => diag + + CS%id_ZB2020u = register_diag_field('ocean_model', 'ZB2020u', diag%axesCuL, Time, & + 'Zonal Acceleration from Zanna-Bolton 2020', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_ZB2020v = register_diag_field('ocean_model', 'ZB2020v', diag%axesCvL, Time, & + 'Meridional Acceleration from Zanna-Bolton 2020', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_KE_ZB2020 = register_diag_field('ocean_model', 'KE_ZB2020', diag%axesTL, Time, & + 'Kinetic Energy Source from Horizontal Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + + CS%id_maskT = register_diag_field('ocean_model', 'maskT', diag%axesTL, Time, & + 'Mask of wet points in T (CENTER) points', '1', conversion=1.) + + CS%id_maskq = register_diag_field('ocean_model', 'maskq', diag%axesBL, Time, & + 'Mask of wet points in q (CORNER) points', '1', conversion=1.) + + ! action of filter on momentum flux + CS%id_S_11 = register_diag_field('ocean_model', 'S_11', diag%axesTL, Time, & + 'Diagonal term (11) in the ZB stress tensor', 'm2s-2', conversion=US%L_T_to_m_s**2) + + CS%id_S_22 = register_diag_field('ocean_model', 'S_22', diag%axesTL, Time, & + 'Diagonal term (22) in the ZB stress tensor', 'm2s-2', conversion=US%L_T_to_m_s**2) + + CS%id_S_12 = register_diag_field('ocean_model', 'S_12', diag%axesBL, Time, & + 'Off-diagonal term in the ZB stress tensor', 'm2s-2', conversion=US%L_T_to_m_s**2) + +end subroutine ZB_2020_init + +!> Baroclinic Zanna-Bolton-2020 parameterization, see +!! eq. 6 in https://laurezanna.github.io/files/Zanna-Bolton-2020.pdf +!! We collect all contributions to a tensor S, with components: +!! (S_11, S_12; +!! S_12, S_22) +!! Which consists of the deviatoric and trace components, respectively: +!! S = (-vort_xy * sh_xy, vort_xy * sh_xx; +!! vort_xy * sh_xx, vort_xy * sh_xy) + +!! 1/2 * (vort_xy^2 + sh_xy^2 + sh_xx^2, 0; +!! 0, vort_xy^2 + sh_xy^2 + sh_xx^2) +!! Where: +!! vort_xy = dv/dx - du/dy - relative vorticity +!! sh_xy = dv/dx + du/dy - shearing deformation (or horizontal shear strain) +!! sh_xx = du/dx - dv/dy - stretching deformation (or horizontal tension) +!! Update of the governing equations: +!! (du/dt, dv/dt) = k_BC * div(S) +!! Where: +!! k_BC = - amplitude * grid_cell_area +!! amplitude = 0.1..10 (approx) + +subroutine Zanna_Bolton_2020(u, v, h, fx, fy, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ZB2020_CS), intent(in) :: CS !< ZB2020 control structure. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: fx !< Zonal acceleration due to convergence of + !! along-coordinate stress tensor [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(out) :: fy !< Meridional acceleration due to convergence + !! of along-coordinate stress tensor [L T-2 ~> m s-2] + + ! Arrays defined in h (CENTER) points + real, dimension(SZI_(G),SZJ_(G)) :: & + dx_dyT, & ! dx/dy at h points [nondim] + dy_dxT, & ! dy/dx at h points [nondim] + dx2h, & ! dx^2 at h points [L2 ~> m2] + dy2h, & ! dy^2 at h points [L2 ~> m2] + dudx, dvdy, & ! Components in the horizontal tension [T-1 ~> s-1] + sh_xx, & ! Horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + vort_xy_center, & ! Vorticity interpolated to the center [T-1 ~> s-1] + sh_xy_center, & ! Shearing strain interpolated to the center [T-1 ~> s-1] + S_11, S_22, & ! Diagonal terms in the ZB stress tensor: + ! Above Line 539 [L2 T-2 ~> m2 s-2] + ! Below Line 539 it is layer-integrated [H L2 T-2 ~> m3 s-2 or kg s-2] + ssd_11, & ! Diagonal component of hyperviscous stress [L2 T-2 ~> m2 s-2] + ssd_11_coef, & ! Viscosity coefficient in hyperviscous stress in center points + ! [L2 T-1 ~> m2 s-1] + mask_T ! Mask of wet points in T (CENTER) points [nondim] + + ! Arrays defined in q (CORNER) points + real, dimension(SZIB_(G),SZJB_(G)) :: & + dx_dyBu, & ! dx/dy at q points [nondim] + dy_dxBu, & ! dy/dx at q points [nondim] + dx2q, & ! dx^2 at q points [L2 ~> m2] + dy2q, & ! dy^2 at q points [L2 ~> m2] + dvdx, dudy, & ! Components in the shearing strain [T-1 ~> s-1] + vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] + sh_xy, & ! Horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + sh_xx_corner, & ! Horizontal tension interpolated to the corner [T-1 ~> s-1] + S_12, & ! Off-diagonal term in the ZB stress tensor: + ! Above Line 539 [L2 T-2 ~> m2 s-2] + ! Below Line 539 it is layer-integrated [H L2 T-2 ~> m3 s-2 or kg s-2] + ssd_12, & ! Off-diagonal component of hyperviscous stress [L2 T-2 ~> m2 s-2] + ssd_12_coef, & ! Viscosity coefficient in hyperviscous stress in corner points + ! [L2 T-1 ~> m2 s-1] + mask_q ! Mask of wet points in q (CORNER) points [nondim] + + ! Thickness arrays for computing the horizontal divergence of the stress tensor + real, dimension(SZIB_(G),SZJB_(G)) :: & + hq ! Thickness in CORNER points [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G)) :: & + h_u ! Thickness interpolated to u points [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJB_(G)) :: & + h_v ! Thickness interpolated to v points [H ~> m or kg m-2]. + + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + mask_T_3d, & ! Mask of wet points in T (CENTER) points [nondim] + S_11_3d, S_22_3d ! Diagonal terms in the ZB stress tensor [L2 T-2 ~> m2 s-2] + + real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & + mask_q_3d, & ! Mask of wet points in q (CORNER) points [nondim] + S_12_3d ! Off-diagonal term in the ZB stress tensor [L2 T-2 ~> m2 s-2] + + real :: h_neglect ! Thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2] + real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6] + real :: h2uq, h2vq ! Temporary variables [H2 ~> m2 or kg2 m-4]. + + real :: sum_sq ! 1/2*(vort_xy^2 + sh_xy^2 + sh_xx^2) [T-2 ~> s-2] + real :: vort_sh ! vort_xy*sh_xy [T-2 ~> s-2] + + real :: k_bc ! Constant in from of the parameterization [L2 ~> m2] + ! Related to the amplitude as follows: + ! k_bc = - amplitude * grid_cell_area < 0 + + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: i, j, k, n + + ! Line 407 of MOM_hor_visc.F90 + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + h_neglect = GV%H_subroundoff ! Line 410 on MOM_hor_visc.F90 + h_neglect3 = h_neglect**3 + + fx(:,:,:) = 0. + fy(:,:,:) = 0. + + ! Calculate metric terms (line 2119 of MOM_hor_visc.F90) + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) + DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) + enddo ; enddo + + ! Calculate metric terms (line 2122 of MOM_hor_visc.F90) + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j) + DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) + enddo ; enddo + + if (CS%ssd_iter > -1) then + ssd_11_coef(:,:) = 0. + ssd_12_coef(:,:) = 0. + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + ssd_11_coef(i,j) = ((CS%ssd_bound_coef * 0.25) / CS%DT) & + * ((dx2h(i,j) * dy2h(i,j)) / (dx2h(i,j) + dy2h(i,j))) + enddo; enddo + + do J=js-1,Jeq ; do I=is-1,Ieq + ssd_12_coef(I,J) = ((CS%ssd_bound_coef * 0.25) / CS%DT) & + * ((dx2q(I,J) * dy2q(I,J)) / (dx2q(I,J) + dy2q(I,J))) + enddo; enddo + endif + + do k=1,nz + + sh_xx(:,:) = 0. + sh_xy(:,:) = 0. + vort_xy(:,:) = 0. + S_12(:,:) = 0. + S_11(:,:) = 0. + S_22(:,:) = 0. + ssd_11(:,:) = 0. + ssd_12(:,:) = 0. + + ! Calculate horizontal tension (line 590 of MOM_hor_visc.F90) + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + dudx(i,j) = DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & + G%IdyCu(I-1,j) * u(I-1,j,k)) + dvdy(i,j) = DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & + G%IdxCv(i,J-1) * v(i,J-1,k)) + sh_xx(i,j) = dudx(i,j) - dvdy(i,j) ! center of the cell + enddo ; enddo + + ! Components for the shearing strain (line 599 of MOM_hor_visc.F90) + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + dvdx(I,J) = DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) + dudy(I,J) = DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) + enddo ; enddo + + ! Shearing strain with free-slip B.C. (line 751 of MOM_hor_visc.F90) + ! We use free-slip as cannot guarantee that non-diagonal stress + ! will accelerate or decelerate currents + ! Note that as there is no stencil operator, set of indices + ! is identical to the previous loop, compared to MOM_hor_visc.F90 + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + sh_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) + dudy(I,J) ) ! corner of the cell + enddo ; enddo + + ! Relative vorticity with free-slip B.C. (line 789 of MOM_hor_visc.F90) + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) ! corner of the cell + enddo ; enddo + + call compute_masks(G, GV, h, mask_T, mask_q, k) + if (CS%id_maskT>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + mask_T_3d(i,j,k) = mask_T(i,j) + enddo; enddo + endif + + if (CS%id_maskq>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + mask_q_3d(i,j,k) = mask_q(i,j) + enddo; enddo + endif + + ! Numerical scheme for ZB2020 requires + ! interpolation center <-> corner + ! This interpolation requires B.C., + ! and that is why B.C. for Velocity Gradients should be + ! well defined + ! The same B.C. will be used by all filtering operators + do J=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 + sh_xx(i,j) = sh_xx(i,j) * mask_T(i,j) + enddo ; enddo + + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + sh_xy(i,j) = sh_xy(i,j) * mask_q(i,j) + vort_xy(i,j) = vort_xy(i,j) * mask_q(i,j) + enddo ; enddo + + if (CS%ssd_iter > -1) then + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + ssd_11(i,j) = sh_xx(i,j) * ssd_11_coef(i,j) + enddo; enddo + + do J=js-1,Jeq ; do I=is-1,Ieq + ssd_12(I,J) = sh_xy(I,J) * ssd_12_coef(I,J) + enddo; enddo + + if (CS%ssd_iter > 0) then + call filter(G, mask_T, mask_q, -1, CS%ssd_iter, T=ssd_11) + call filter(G, mask_T, mask_q, -1, CS%ssd_iter, q=ssd_12) + endif + endif + + call filter(G, mask_T, mask_q, -CS%HPF_iter, CS%HPF_order, T=sh_xx) + call filter(G, mask_T, mask_q, +CS%LPF_iter, CS%LPF_order, T=sh_xx) + + call filter(G, mask_T, mask_q, -CS%HPF_iter, CS%HPF_order, q=sh_xy) + call filter(G, mask_T, mask_q, +CS%LPF_iter, CS%LPF_order, q=sh_xy) + + call filter(G, mask_T, mask_q, -CS%HPF_iter, CS%HPF_order, q=vort_xy) + call filter(G, mask_T, mask_q, +CS%LPF_iter, CS%LPF_order, q=vort_xy) + + ! Corner to center interpolation (line 901 of MOM_hor_visc.F90) + ! lower index as in loop for sh_xy, but minus 1 + ! upper index is identical + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + sh_xy_center(i,j) = 0.25 * ( (sh_xy(I-1,J-1) + sh_xy(I,J)) & + + (sh_xy(I-1,J) + sh_xy(I,J-1)) ) + vort_xy_center(i,j) = 0.25 * ( (vort_xy(I-1,J-1) + vort_xy(I,J)) & + + (vort_xy(I-1,J) + vort_xy(I,J-1)) ) + enddo ; enddo + + ! Center to corner interpolation + ! lower index as in loop for sh_xx + ! upper index as in the same loop, but minus 1 + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + sh_xx_corner(I,J) = 0.25 * ( (sh_xx(i+1,j+1) + sh_xx(i,j)) & + + (sh_xx(i+1,j) + sh_xx(i,j+1))) + enddo ; enddo + + ! WITH land mask (line 622 of MOM_hor_visc.F90) + ! Use of mask eliminates dependence on the + ! values on land + do j=js-2,je+2 ; do I=Isq-1,Ieq+1 + h_u(I,j) = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i+1,j)*h(i+1,j,k)) + enddo ; enddo + do J=Jsq-1,Jeq+1 ; do i=is-2,ie+2 + h_v(i,J) = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i,j+1)*h(i,j+1,k)) + enddo ; enddo + + ! Line 1187 of MOM_hor_visc.F90 + do J=js-1,Jeq ; do I=is-1,Ieq + h2uq = 4.0 * (h_u(I,j) * h_u(I,j+1)) + h2vq = 4.0 * (h_v(i,J) * h_v(i+1,J)) + hq(I,J) = (2.0 * (h2uq * h2vq)) & + / (h_neglect3 + (h2uq + h2vq) * ((h_u(I,j) + h_u(I,j+1)) + (h_v(i,J) + h_v(i+1,J)))) + enddo ; enddo + + ! Form S_11 and S_22 tensors + ! Indices - intersection of loops for + ! sh_xy_center and sh_xx + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + if (CS%ZB_type == 1) then + sum_sq = 0. + else + sum_sq = 0.5 * & + (vort_xy_center(i,j)**2 + sh_xy_center(i,j)**2 + sh_xx(i,j)**2) + endif + + if (CS%ZB_type == 2) then + vort_sh = 0. + else + if (CS%ZB_cons == 1) then + vort_sh = 0.25 * ( & + (G%areaBu(I-1,J-1) * vort_xy(I-1,J-1) * sh_xy(I-1,J-1) + & + G%areaBu(I ,J ) * vort_xy(I ,J ) * sh_xy(I ,J )) + & + (G%areaBu(I-1,J ) * vort_xy(I-1,J ) * sh_xy(I-1,J ) + & + G%areaBu(I ,J-1) * vort_xy(I ,J-1) * sh_xy(I ,J-1)) & + ) * G%IareaT(i,j) + else if (CS%ZB_cons == 0) then + vort_sh = vort_xy_center(i,j) * sh_xy_center(i,j) + endif + endif + k_bc = - CS%amplitude * G%areaT(i,j) + S_11(i,j) = k_bc * (- vort_sh + sum_sq) + S_22(i,j) = k_bc * (+ vort_sh + sum_sq) + enddo ; enddo + + ! Form S_12 tensor + ! indices correspond to sh_xx_corner loop + do J=Jsq-1,Jeq ; do I=Isq-1,Ieq + if (CS%ZB_type == 2) then + vort_sh = 0. + else + vort_sh = vort_xy(I,J) * sh_xx_corner(I,J) + endif + k_bc = - CS%amplitude * G%areaBu(i,j) + S_12(I,J) = k_bc * vort_sh + enddo ; enddo + + call filter(G, mask_T, mask_q, CS%Stress_iter, CS%Stress_order, T=S_11) + call filter(G, mask_T, mask_q, CS%Stress_iter, CS%Stress_order, T=S_22) + call filter(G, mask_T, mask_q, CS%Stress_iter, CS%Stress_order, q=S_12) + + if (CS%ssd_iter>-1) then + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + S_11(i,j) = S_11(i,j) + ssd_11(i,j) + S_22(i,j) = S_22(i,j) - ssd_11(i,j) + enddo ; enddo + do J=js-1,Jeq ; do I=is-1,Ieq + S_12(I,J) = S_12(I,J) + ssd_12(I,J) + enddo ; enddo + endif + + if (CS%id_S_11>0) then + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + S_11_3d(i,j,k) = S_11(i,j) + enddo; enddo + endif + + if (CS%id_S_22>0) then + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + S_22_3d(i,j,k) = S_22(i,j) + enddo; enddo + endif + + if (CS%id_S_12>0) then + do J=js-1,Jeq ; do I=is-1,Ieq + S_12_3d(I,J,k) = S_12(I,J) + enddo; enddo + endif + + ! Weight with interface height (Line 1478 of MOM_hor_visc.F90) + ! Note that reduction is removed + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + S_11(i,j) = S_11(i,j) * h(i,j,k) + S_22(i,j) = S_22(i,j) * h(i,j,k) + enddo ; enddo + + ! Free slip (Line 1487 of MOM_hor_visc.F90) + do J=js-1,Jeq ; do I=is-1,Ieq + S_12(I,J) = S_12(I,J) * (hq(I,J) * G%mask2dBu(I,J)) + enddo ; enddo + + ! Evaluate 1/h x.Div(h S) (Line 1495 of MOM_hor_visc.F90) + ! Minus occurs because in original file (du/dt) = - div(S), + ! but here is the discretization of div(S) + do j=js,je ; do I=Isq,Ieq + fx(I,j,k) = - ((G%IdyCu(I,j)*(dy2h(i,j) *S_11(i,j) - & + dy2h(i+1,j)*S_11(i+1,j)) + & + G%IdxCu(I,j)*(dx2q(I,J-1)*S_12(I,J-1) - & + dx2q(I,J) *S_12(I,J))) * & + G%IareaCu(I,j)) / (h_u(I,j) + h_neglect) + enddo ; enddo + + ! Evaluate 1/h y.Div(h S) (Line 1517 of MOM_hor_visc.F90) + do J=Jsq,Jeq ; do i=is,ie + fy(i,J,k) = - ((G%IdyCv(i,J)*(dy2q(I-1,J)*S_12(I-1,J) - & + dy2q(I,J) *S_12(I,J)) + & ! NOTE this plus + G%IdxCv(i,J)*(dx2h(i,j) *S_22(i,j) - & + dx2h(i,j+1)*S_22(i,j+1))) * & + G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) + enddo ; enddo + + enddo ! end of k loop + + if (CS%id_ZB2020u>0) call post_data(CS%id_ZB2020u, fx, CS%diag) + if (CS%id_ZB2020v>0) call post_data(CS%id_ZB2020v, fy, CS%diag) + + if (CS%id_maskT>0) call post_data(CS%id_maskT, mask_T_3d, CS%diag) + if (CS%id_maskq>0) call post_data(CS%id_maskq, mask_q_3d, CS%diag) + + if (CS%id_S_11>0) call post_data(CS%id_S_11, S_11_3d, CS%diag) + + if (CS%id_S_22>0) call post_data(CS%id_S_22, S_22_3d, CS%diag) + + if (CS%id_S_12>0) call post_data(CS%id_S_12, S_12_3d, CS%diag) + + call compute_energy_source(u, v, h, fx, fy, G, GV, CS) + +end subroutine Zanna_Bolton_2020 + +!> Filter which is used to smooth velocity gradient tensor +!! or the stress tensor. +!! If n_lowpass and n_highpass are positive, +!! the filter is given by: +!! I - (I-G^n_lowpass)^n_highpass +!! where I is the identity matrix and G is smooth_Tq(). +!! It is filter of order 2*n_highpass, +!! where n_lowpass is the number of iterations +!! which defines the filter scale. +!! If n_lowpass is negative, returns residual +!! for the same filter: +!! (I-G^|n_lowpass|)^n_highpass +!! Input does not require halo. Output has full halo. +subroutine filter(G, mask_T, mask_q, n_lowpass, n_highpass, T, q) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + integer, intent(in) :: n_lowpass !< number of low-pass iterations + integer, intent(in) :: n_highpass !< number of high-pass iterations + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: mask_T !< mask of wet points in T (CENTER) points [nondim] + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: mask_q !< mask of wet points in q (CORNER) points [nondim] + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(inout) :: T !< any field at T (CENTER) points [arbitrary] + real, dimension(SZIB_(G),SZJB_(G)), & + optional, intent(inout) :: q !< any field at q (CORNER) points [arbitrary] + + real, dimension(SZIB_(G),SZJB_(G)) :: q1, q2 ! intermediate q-fields [arbitrary] + real, dimension(SZI_(G),SZJ_(G)) :: T1, T2 ! intermediate T-fields [arbitrary] + real :: max_before, min_before, max_after, min_after ! minimum and maximum values of fields + ! before and after filtering [arbitrary] + + integer :: i_highpass, i_lowpass + integer :: i, j + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + if (n_lowpass==0) then + return + endif + + ! Total operator is I - (I-G^n_lowpass)^n_highpass + if (present(q)) then + call pass_var(q, G%Domain, position=CORNER, complete=.true.) + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + q(I,J) = q(I,J) * mask_q(I,J) + enddo ; enddo + + if (n_highpass==1 .AND. n_lowpass>0) then + call min_max(G, min_before, max_before, q=q) + endif + + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + q1(I,J) = q(I,J) + enddo ; enddo + + ! q1 -> ((I-G^n_lowpass)^n_highpass)*q1 + do i_highpass=1,n_highpass + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + q2(I,J) = q1(I,J) + enddo ; enddo + ! q2 -> (G^n_lowpass)*q2 + do i_lowpass=1,ABS(n_lowpass) + call smooth_Tq(G, mask_T, mask_q, q=q2) + enddo + ! q1 -> (I-G^n_lowpass)*q1 + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + q1(I,J) = q1(I,J) - q2(I,J) + enddo ; enddo + enddo + + if (n_lowpass>0) then + ! q -> q - ((I-G^n_lowpass)^n_highpass)*q + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + q(I,J) = q(I,J) - q1(I,J) + enddo ; enddo + else + ! q -> ((I-G^n_lowpass)^n_highpass)*q + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + q(I,J) = q1(I,J) + enddo ; enddo + endif + + if (n_highpass==1 .AND. n_lowpass>0) then + call min_max(G, min_after, max_after, q=q) + if (max_after > max_before .OR. min_after < min_before) then + call MOM_error(WARNING, "MOM_Zanna_Bolton.F90, filter applied in CORNER points "//& + "does not preserve [min,max] values. There may be issues with "//& + "boundary conditions") + endif + endif + endif + + if (present(T)) then + call pass_var(T, G%Domain) + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + T(i,j) = T(i,j) * mask_T(i,j) + enddo ; enddo + + if (n_highpass==1 .AND. n_lowpass>0) then + call min_max(G, min_before, max_before, T=T) + endif + + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + T1(i,j) = T(i,j) + enddo ; enddo + + do i_highpass=1,n_highpass + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + T2(i,j) = T1(i,j) + enddo ; enddo + do i_lowpass=1,ABS(n_lowpass) + call smooth_Tq(G, mask_T, mask_q, T=T2) + enddo + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + T1(i,j) = T1(i,j) - T2(i,j) + enddo ; enddo + enddo + + if (n_lowpass>0) then + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + T(i,j) = T(i,j) - T1(i,j) + enddo ; enddo + else + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + T(i,j) = T1(i,j) + enddo ; enddo + endif + + if (n_highpass==1 .AND. n_lowpass>0) then + call min_max(G, min_after, max_after, T=T) + if (max_after > max_before .OR. min_after < min_before) then + call MOM_error(WARNING, "MOM_Zanna_Bolton.F90, filter applied in CENTER points "//& + " does not preserve [min,max] values. There may be issues with "//& + " boundary conditions") + endif + endif + endif +end subroutine filter + +!> One iteration of 3x3 filter +!! [1 2 1; +!! 2 4 2; +!! 1 2 1]/16 +!! removing chess-harmonic. +!! It is used as a buiding block in filter(). +!! Zero Dirichlet boundary conditions are applied +!! with mask_T and mask_q. +subroutine smooth_Tq(G, mask_T, mask_q, T, q) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: mask_T !< mask of wet points in T (CENTER) points [nondim] + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: mask_q !< mask of wet points in q (CORNER) points [nondim] + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(inout) :: T !< any field at T (CENTER) points [arbitrary] + real, dimension(SZIB_(G),SZJB_(G)), & + optional, intent(inout) :: q !< any field at q (CORNER) points [arbitrary] + + real, dimension(SZI_(G),SZJ_(G)) :: Tim ! intermediate T-field [arbitrary] + real, dimension(SZIB_(G),SZJB_(G)) :: qim ! intermediate q-field [arbitrary] + + real :: wside ! weights for side points + ! (i+1,j), (i-1,j), (i,j+1), (i,j-1) + ! [nondim] + real :: wcorner ! weights for corner points + ! (i+1,j+1), (i+1,j-1), (i-1,j-1), (i-1,j+1) + ! [nondim] + real :: wcenter ! weight for the center point (i,j) [nondim] + + integer :: i, j + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + wside = 1. / 8. + wcorner = 1. / 16. + wcenter = 1. - (wside*4. + wcorner*4.) + + if (present(q)) then + call pass_var(q, G%Domain, position=CORNER, complete=.true.) + do J = Jsq-1, Jeq+1; do I = Isq-1, Ieq+1 + qim(I,J) = q(I,J) * mask_q(I,J) + enddo; enddo + do J = Jsq, Jeq + do I = Isq, Ieq + q(I,J) = wcenter * qim(i,j) & + + wcorner * ( & + (qim(I-1,J-1)+qim(I+1,J+1)) & + + (qim(I-1,J+1)+qim(I+1,J-1)) & + ) & + + wside * ( & + (qim(I-1,J)+qim(I+1,J)) & + + (qim(I,J-1)+qim(I,J+1)) & + ) + q(I,J) = q(I,J) * mask_q(I,J) + enddo + enddo + call pass_var(q, G%Domain, position=CORNER, complete=.true.) + endif + + if (present(T)) then + call pass_var(T, G%Domain) + do j = js-1, je+1; do i = is-1, ie+1 + Tim(i,j) = T(i,j) * mask_T(i,j) + enddo; enddo + do j = js, je + do i = is, ie + T(i,j) = wcenter * Tim(i,j) & + + wcorner * ( & + (Tim(i-1,j-1)+Tim(i+1,j+1)) & + + (Tim(i-1,j+1)+Tim(i+1,j-1)) & + ) & + + wside * ( & + (Tim(i-1,j)+Tim(i+1,j)) & + + (Tim(i,j-1)+Tim(i,j+1)) & + ) + T(i,j) = T(i,j) * mask_T(i,j) + enddo + enddo + call pass_var(T, G%Domain) + endif + +end subroutine smooth_Tq + +!> Returns min and max values of array across all PEs. +!! It is used in filter() to check its monotonicity. +subroutine min_max(G, min_val, max_val, T, q) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(inout) :: T !< any field at T (CENTER) points [arbitrary] + real, dimension(SZIB_(G),SZJB_(G)), & + optional, intent(inout) :: q !< any field at q (CORNER) points [arbitrary] + real, intent(out) :: min_val, max_val !< min and max values of array accross PEs [arbitrary] + + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + if (present(q)) then + min_val = minval(q(Isq:Ieq, Jsq:Jeq)) + max_val = maxval(q(Isq:Ieq, Jsq:Jeq)) + endif + + if (present(T)) then + min_val = minval(T(is:ie, js:je)) + max_val = maxval(T(is:ie, js:je)) + endif + + call min_across_PEs(min_val) + call max_across_PEs(max_val) + +end subroutine + +!> Computes mask of wet points in T (CENTER) and q (CORNER) points. +!! Method: compare layer thicknesses with Angstrom_H. +!! Mask is computed separately for every vertical layer and +!! for every time step. +subroutine compute_masks(G, GV, h, mask_T, mask_q, k) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: mask_T !< mask of wet points in T (CENTER) points [nondim] + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: mask_q !< mask of wet points in q (CORNER) points [nondim] + integer, intent(in) :: k !< index of vertical layer + + real :: hmin ! Minimum layer thickness + ! beyond which we have boundary [H ~> m or kg m-2] + integer :: i, j + + hmin = GV%Angstrom_H * 2. + + mask_q(:,:) = 0. + do J = G%JscB, G%JecB + do I = G%IscB, G%IecB + if (h(i+1,j+1,k) < hmin .or. & + h(i ,j ,k) < hmin .or. & + h(i+1,j ,k) < hmin .or. & + h(i ,j+1,k) < hmin & + ) then + mask_q(I,J) = 0. + else + mask_q(I,J) = 1. + endif + mask_q(I,J) = mask_q(I,J) * G%mask2dBu(I,J) + enddo + enddo + call pass_var(mask_q, G%Domain, position=CORNER, complete=.true.) + + mask_T(:,:) = 0. + do j = G%jsc, G%jec + do i = G%isc, G%iec + if (h(i,j,k) < hmin) then + mask_T(i,j) = 0. + else + mask_T(i,j) = 1. + endif + mask_T(i,j) = mask_T(i,j) * G%mask2dT(i,j) + enddo + enddo + call pass_var(mask_T, G%Domain) + +end subroutine compute_masks + +!> Computes the 3D energy source term for the ZB2020 scheme +!! similarly to MOM_diagnostics.F90, specifically 1125 line. +subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ZB2020_CS), intent(in) :: CS !< ZB2020 control structure. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: fx !< Zonal acceleration due to convergence of + !! along-coordinate stress tensor [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in) :: fy !< Meridional acceleration due to convergence + !! of along-coordinate stress tensor [L T-2 ~> m s-2] + + real :: KE_term(SZI_(G),SZJ_(G),SZK_(GV)) ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real :: KE_u(SZIB_(G),SZJ_(G)) ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_v(SZI_(G),SZJB_(G)) ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + + !real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! temporary array for integration + !real :: global_integral ! Global integral of the energy effect of ZB2020 + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + + + real :: uh ! Transport through zonal faces = u*h*dy, + ! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vh ! Transport through meridional faces = v*h*dx, + ! [H L2 T-1 ~> m3 s-1 or kg s-1]. + + type(group_pass_type) :: pass_KE_uv ! A handle used for group halo passes + + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: i, j, k + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + if (CS%id_KE_ZB2020 > 0) then + call create_group_pass(pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) + + KE_term(:,:,:) = 0. + !tmp(:,:,:) = 0. + ! Calculate the KE source from Zanna-Bolton2020 [H L2 T-3 ~> m3 s-3]. + do k=1,nz + KE_u(:,:) = 0. + KE_v(:,:) = 0. + do j=js,je ; do I=Isq,Ieq + uh = u(I,j,k) * 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i+1,j)*h(i+1,j,k)) * & + G%dyCu(I,j) + KE_u(I,j) = uh * G%dxCu(I,j) * fx(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + vh = v(i,J,k) * 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i,j+1)*h(i,j+1,k)) * & + G%dxCv(i,J) + KE_v(i,J) = vh * G%dyCv(i,J) * fy(i,J,k) + enddo ; enddo + call do_group_pass(pass_KE_uv, G%domain) + do j=js,je ; do i=is,ie + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) + ! copy-paste from MOM_spatial_means.F90, line 42 + !tmp(i,j,k) = KE_term(i,j,k) * G%areaT(i,j) * G%mask2dT(i,j) + enddo ; enddo + enddo + + !global_integral = reproducing_sum(tmp) + + call post_data(CS%id_KE_ZB2020, KE_term, CS%diag) + endif + +end subroutine compute_energy_source + +end module MOM_Zanna_Bolton \ No newline at end of file diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index e6dd131a99..9037c71c5a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -23,6 +23,7 @@ module MOM_hor_visc use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_variables, only : accel_diag_ptrs +use MOM_Zanna_Bolton, only : Zanna_Bolton_2020, ZB_2020_init, ZB2020_CS implicit none ; private @@ -105,6 +106,9 @@ module MOM_hor_visc real :: min_grid_Ah !< Minimun horizontal biharmonic viscosity used to !! limit grid Reynolds number [L4 T-1 ~> m4 s-1] + type(ZB2020_CS) :: ZB2020 !< Zanna-Bolton 2020 control structure. + logical :: use_ZB2020 !< If true, use Zanna-Bolton 2020 parameterization. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this @@ -329,6 +333,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grid_Re_Kh, & ! Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] grid_Re_Ah, & ! Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] GME_coeff_h ! GME coefficient at h-points [L2 T-1 ~> m2 s-1] + + ! Zanna-Bolton fields + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & + ZB2020u !< Zonal acceleration due to convergence of + !! along-coordinate stress tensor for ZB model + !! [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & + ZB2020v !< Meridional acceleration due to convergence + !! of along-coordinate stress tensor for ZB model + !! [L T-2 ~> m s-2] + real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Shear_mag_bc ! Shear_mag value in backscatter [T-1 ~> s-1] @@ -1607,6 +1622,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ! end of k loop + if (CS%use_ZB2020) then + call Zanna_Bolton_2020(u, v, h, ZB2020u, ZB2020v, G, GV, CS%ZB2020) + + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + diffu(I,j,k) = diffu(I,j,k) + ZB2020u(I,j,k) + enddo ; enddo ; enddo + + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + diffv(i,J,k) = diffv(i,J,k) + ZB2020v(i,J,k) + enddo ; enddo ; enddo + endif + ! Offer fields for diagnostic averaging. if (CS%id_normstress > 0) call post_data(CS%id_normstress, NoSt, CS%diag) if (CS%id_shearstress > 0) call post_data(CS%id_shearstress, ShSt, CS%diag) @@ -1753,6 +1780,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + ! init control structure + call ZB_2020_init(Time, GV, US, param_file, diag, CS%ZB2020, CS%use_ZB2020) + CS%initialized = .true. CS%diag => diag diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 6dda4c1b1c..8c56107a4f 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -23,7 +23,7 @@ module MOM_internal_tides use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_wave_structure, only: wave_structure_init, wave_structure, wave_structure_CS +use MOM_wave_speed, only : wave_speeds, wave_speed_CS, wave_speed_init implicit none ; private @@ -40,6 +40,8 @@ module MOM_internal_tides integer :: nMode = 1 !< The number of internal tide vertical modes integer :: nAngle = 24 !< The number of internal tide angular orientations integer :: energized_angle = -1 !< If positive, only this angular band is energized for debugging purposes + real :: uniform_test_cg !< Uniform group velocity of internal tide + !! for testing internal tides [L T-1 ~> m s-1] logical :: corner_adv !< If true, use a corner advection rather than PPM. logical :: upwind_1st !< If true, use a first-order upwind scheme. logical :: simple_2nd !< If true, use a simple second order (arithmetic mean) interpolation @@ -95,6 +97,20 @@ module MOM_internal_tides !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] + real, allocatable, dimension(:,:,:,:) :: w_struct !< Vertical structure of vertical velocity (normalized) + !! for each frequency and each mode [nondim] + real, allocatable, dimension(:,:,:,:) :: u_struct !< Vertical structure of horizontal velocity (normalized and + !! divided by layer thicknesses) for each frequency and each mode [Z-1 ~> m-1] + real, allocatable, dimension(:,:,:) :: u_struct_max !< Maximum of u_struct, + !! for each mode [Z-1 ~> m-1] + real, allocatable, dimension(:,:,:) :: u_struct_bot !< Bottom value of u_struct, + !! for each mode [Z-1 ~> m-1] + real, allocatable, dimension(:,:,:) :: int_w2 !< Vertical integral of w_struct squared, + !! for each mode [Z ~> m] + real, allocatable, dimension(:,:,:) :: int_U2 !< Vertical integral of u_struct squared, + !! for each mode [Z-1 ~> m-1] + real, allocatable, dimension(:,:,:) :: int_N2w2 !< Depth-integrated Brunt Vaissalla freqency times + !! vertical profile squared, for each mode [Z T-2 ~> m s-2] real :: q_itides !< fraction of local dissipation [nondim] real :: En_sum !< global sum of energy for use in debugging, in MKS units [J] type(time_type), pointer :: Time => NULL() !< A pointer to the model's clock. @@ -124,12 +140,14 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle); temporary for restart real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1]. + type(wave_speed_CS) :: wave_speed !< Wave speed control structure type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(wave_structure_CS) :: wave_struct !< Wave structure control structure !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles + integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed + integer, allocatable, dimension(:) :: id_cn ! diagnostic handle for all mode speeds integer :: id_tot_En = -1, id_TKE_itidal_input = -1, id_itide_drag = -1 integer :: id_refl_pref = -1, id_refl_ang = -1, id_land_mask = -1 integer :: id_trans = -1, id_residual = -1 @@ -148,6 +166,12 @@ module MOM_internal_tides integer, allocatable, dimension(:,:) :: & id_En_ang_mode, & id_itidal_loss_ang_mode + integer, allocatable, dimension(:) :: & + id_Ustruct_mode, & + id_Wstruct_mode, & + id_int_w2_mode, & + id_int_U2_mode, & + id_int_N2w2_mode !>@} end type int_tide_CS @@ -163,7 +187,7 @@ module MOM_internal_tides !> Calls subroutines in this file that are needed to refract, propagate, !! and dissipate energy density of the internal tide. -subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & +subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -176,16 +200,18 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & !! internal waves [R Z3 T-3 ~> W m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read !! from file [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. + !! In some cases the input values are used, but in + !! others this is set along with the wave speeds. real, intent(in) :: dt !< Length of time over which to advance !! the internal tides [T ~> s]. type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure - real, dimension(SZI_(G),SZJ_(G),CS%nMode), & - intent(in) :: cn !< The internal wave speeds of each - !! mode [L T-1 ~> m s-1]. + ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & test ! A test unit vector used to determine grid rotation in halos [nondim] + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn ! baroclinic internal gravity wave speeds for each mode [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only [R Z3 T-2 ~> J m-2] Ub, & ! near-bottom horizontal velocity of wave (modal) [L T-1 ~> m s-1] @@ -205,6 +231,10 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real :: I_D_here ! The inverse of the local depth [Z-1 ~> m-1] real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: PE_term ! total potential energy of profile [R Z ~> kg m-2] + real :: KE_term ! total kinetic energy of profile [R Z ~> kg m-2] + real :: U_mag ! rescaled magnitude of horizontal profile [L Z T-1 ~> m2 s-1] + real :: W0 ! rescaled magnitude of vertical profile [Z T-1 ~> m s-1] real :: c_phase ! The phase speed [L T-1 ~> m s-1] real :: loss_rate ! An energy loss rate [T-1 ~> s-1] real :: Fr2_max ! The column maximum internal wave Froude number squared [nondim] @@ -222,6 +252,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle + nzm = GV%ke I_rho0 = 1.0 / GV%Rho0 cn_subRO = 1e-30*US%m_s_to_L_T en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T @@ -229,6 +260,19 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! initialize local arrays drag_scale(:,:) = 0. Ub(:,:,:,:) = 0. + Umax(:,:,:,:) = 0. + + cn(:,:,:) = 0. + + ! Set properties related to the internal tides, such as the wave speeds, storing some + ! of them in the control structure for this module. + if (CS%uniform_test_cg > 0.0) then + do m=1,CS%nMode ; cn(:,:,m) = CS%uniform_test_cg ; enddo + else + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, CS%wave_speed, & + CS%w_struct, CS%u_struct, CS%u_struct_max, CS%u_struct_bot, & + Nb, CS%int_w2, CS%int_U2, CS%int_N2w2, full_halos=.true.) + endif ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** ! This is wrong, of course, but it works reasonably in some cases. @@ -417,15 +461,43 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! First, find velocity profiles if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then do m=1,CS%NMode ; do fr=1,CS%Nfreq - ! Calculate modal structure for given mode and frequency - call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, CS%frequency(fr), & - CS%wave_struct, tot_En_mode(:,:,fr,m), full_halos=.true.) - ! Pick out near-bottom and max horizontal baroclinic velocity values at each point + + ! compute near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging - nzm = CS%wave_struct%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_struct%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_struct%Uavg_profile(i,j,1:nzm)) + + ! Calculate wavenumber magnitude + freq2 = CS%frequency(fr)**2 + + f2 = (0.25*(G%CoriolisBu(I,J) + G%CoriolisBu(max(I-1,1),max(J-1,1)) + & + G%CoriolisBu(I,max(J-1,1)) + G%CoriolisBu(max(I-1,1),J)))**2 + Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) + + + ! Back-calculate amplitude from energy equation + if ( (G%mask2dT(i,j) > 0.5) .and. (freq2*Kmag2 > 0.0)) then + ! Units here are [R Z ~> kg m-2] + KE_term = 0.25*GV%Rho0*( ((freq2 + f2) / (freq2*Kmag2))*US%L_to_Z**2*CS%int_U2(i,j,m) + & + CS%int_w2(i,j,m) ) + PE_term = 0.25*GV%Rho0*( CS%int_N2w2(i,j,m) / freq2 ) + + if (KE_term + PE_term > 0.0) then + W0 = sqrt( tot_En_mode(i,j,fr,m) / (KE_term + PE_term) ) + else + !call MOM_error(WARNING, "MOM internal tides: KE + PE <= 0.0; setting to W0 to 0.0") + W0 = 0.0 + endif + + U_mag = W0 * sqrt((freq2 + f2) / (2.0*freq2*Kmag2)) + ! scaled maximum tidal velocity + Umax(i,j,fr,m) = abs(U_mag * CS%u_struct_max(i,j,m)) + ! scaled bottom tidal velocity + Ub(i,j,fr,m) = abs(U_mag * CS%u_struct_bot(i,j,m)) + else + Umax(i,j,fr,m) = 0. + Ub(i,j,fr,m) = 0. + endif + enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -454,7 +526,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Pick out maximum baroclinic velocity values; calculate Fr=max(u)/cg do m=1,CS%NMode ; do fr=1,CS%Nfreq freq2 = CS%frequency(fr)**2 - do j=jsd,jed ; do i=isd,ied + do j=js,je ; do i=is,ie id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & @@ -463,7 +535,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) - nzm = CS%wave_struct%num_intfaces(i,j) Fr2_max = (Umax(i,j,fr,m) / c_phase)**2 ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then @@ -545,6 +616,10 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call enable_averages(dt, time_end, CS%diag) if (query_averaging_enabled(CS%diag)) then + ! Output internal wave modal wave speeds + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) + do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m), cn(:,:,m), CS%diag) ; enddo + ! Output two-dimensional diagnostics if (CS%id_tot_En > 0) call post_data(CS%id_tot_En, tot_En, CS%diag) if (CS%id_itide_drag > 0) call post_data(CS%id_itide_drag, drag_scale, CS%diag) @@ -635,6 +710,26 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_Ub_mode(fr,m), Ub(:,:,fr,m), CS%diag) endif ; enddo ; enddo + do m=1,CS%NMode ; if (CS%id_Ustruct_mode(m) > 0) then + call post_data(CS%id_Ustruct_mode(m), CS%u_struct(:,:,:,m), CS%diag) + endif ; enddo + + do m=1,CS%NMode ; if (CS%id_Wstruct_mode(m) > 0) then + call post_data(CS%id_Wstruct_mode(m), CS%w_struct(:,:,:,m), CS%diag) + endif ; enddo + + do m=1,CS%NMode ; if (CS%id_int_w2_mode(m) > 0) then + call post_data(CS%id_int_w2_mode(m), CS%int_w2(:,:,m), CS%diag) + endif ; enddo + + do m=1,CS%NMode ; if (CS%id_int_U2_mode(m) > 0) then + call post_data(CS%id_int_U2_mode(m), CS%int_U2(:,:,m), CS%diag) + endif ; enddo + + do m=1,CS%NMode ; if (CS%id_int_N2w2_mode(m) > 0) then + call post_data(CS%id_int_N2w2_mode(m), CS%int_N2w2(:,:,m), CS%diag) + endif ; enddo + ! Output 2-D horizontal phase velocity for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_cp_mode(fr,m) > 0) then call post_data(CS%id_cp_mode(fr,m), CS%cp(:,:,fr,m), CS%diag) @@ -2221,12 +2316,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) real, dimension(:,:), allocatable :: ridge_temp ! array for temporary storage of flags ! of cells with double-reflecting ridges [nondim] logical :: use_int_tides, use_temperature + real :: IGW_c1_thresh ! A threshold first mode internal wave speed below which all higher + ! mode speeds are not calculated but simply assigned a speed of 0 [L T-1 ~> m s-1]. real :: kappa_h2_factor ! A roughness scaling factor [nondim] real :: RMS_roughness_frac ! The maximum RMS topographic roughness as a fraction of the ! nominal ocean depth, or a negative value for no limit [nondim] real :: period_1 ! The period of the gravest modeled mode [T ~> s] integer :: num_angle, num_freq, num_mode, m, fr - integer :: isd, ied, jsd, jed, a, id_ang, i, j + integer :: isd, ied, jsd, jed, a, id_ang, i, j, nz type(axes_grp) :: axes_ang ! This include declares and sets the variable "version". # include "version_variable.h" @@ -2241,6 +2338,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) character(len=80) :: rough_var ! Input file variable names isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + nz = GV%ke use_int_tides = .false. call read_param(param_file, "INTERNAL_TIDES", use_int_tides) @@ -2250,8 +2348,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) use_temperature = .true. call read_param(param_file, "ENABLE_THERMODYNAMICS", use_temperature) if (.not.use_temperature) call MOM_error(FATAL, & - "register_int_tide_restarts: internal_tides only works with "//& - "ENABLE_THERMODYNAMICS defined.") + "internal_tides_init: internal_tides only works with ENABLE_THERMODYNAMICS defined.") ! Set number of frequencies, angles, and modes to consider num_freq = 1 ; num_angle = 24 ; num_mode = 1 @@ -2375,6 +2472,15 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress.", & units="nondim", default=0.003) + call get_param(param_file, mdl, "INTERNAL_WAVE_CG1_THRESH", IGW_c1_thresh, & + "A minimal value of the first mode internal wave speed below which all higher "//& + "mode speeds are not calculated but are simply reported as 0. This must be "//& + "non-negative for the wave_speeds routine to be used.", & + units="m s-1", default=0.01, scale=US%m_s_to_L_T) + + call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & + "If positive, a uniform group velocity of internal tide for test case", & + default=-1., units="m s-1", scale=US%m_s_to_L_T) call get_param(param_file, mdl, "INTERNAL_TIDE_ENERGIZED_ANGLE", CS%energized_angle, & "If positive, only one angular band of the internal tides "//& "gets all of the energy. (This is for debugging.)", default=-1) @@ -2407,6 +2513,13 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_Froude_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_residual_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%u_struct_bot(isd:ied,jsd:jed,num_mode), source=0.0) + allocate(CS%u_struct_max(isd:ied,jsd:jed,num_mode), source=0.0) + allocate(CS%int_w2(isd:ied,jsd:jed,num_mode), source=0.0) + allocate(CS%int_U2(isd:ied,jsd:jed,num_mode), source=0.0) + allocate(CS%int_N2w2(isd:ied,jsd:jed,num_mode), source=0.0) + allocate(CS%w_struct(isd:ied,jsd:jed,1:nz+1,num_mode), source=0.0) + allocate(CS%u_struct(isd:ied,jsd:jed,1:nz,num_mode), source=0.0) ! Compute the fixed part of the bottom drag loss from baroclinic modes call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -2531,6 +2644,18 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo call pass_var(CS%residual,G%domain) + CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & + Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s) + allocate(CS%id_cn(CS%nMode), source=-1) + do m=1,CS%nMode + write(var_name, '("cn_mode",i1)') m + write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m + CS%id_cn(m) = register_diag_field('ocean_model',var_name, diag%axesT1, & + Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + enddo + + ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & Time, 'Local angle of coastline/ridge/shelf with respect to equator', 'rad') @@ -2593,6 +2718,11 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%id_allprocesses_loss_mode(CS%nFreq,CS%nMode), source=-1) allocate(CS%id_itidal_loss_ang_mode(CS%nFreq,CS%nMode), source=-1) allocate(CS%id_Ub_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_Ustruct_mode(CS%nMode), source=-1) + allocate(CS%id_Wstruct_mode(CS%nMode), source=-1) + allocate(CS%id_int_w2_mode(CS%nMode), source=-1) + allocate(CS%id_int_U2_mode(CS%nMode), source=-1) + allocate(CS%id_int_N2w2_mode(CS%nMode), source=-1) allocate(CS%id_cp_mode(CS%nFreq,CS%nMode), source=-1) allocate(angles(CS%NAngle), source=0.0) @@ -2656,8 +2786,45 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo - ! Initialize wave_structure (not sure if this should be here - BDM) - call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_struct) + + do m=1,CS%nMode + + ! Register 3-D internal tide horizonal velocity profile for each mode + write(var_name, '("Itide_Ustruct","_mode",i1)') m + write(var_descript, '("horizonal velocity profile for mode ",i1)') m + CS%id_Ustruct_mode(m) = register_diag_field('ocean_model', var_name, & + diag%axesTl, Time, var_descript, 'm-1', conversion=US%m_to_L) + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + + ! Register 3-D internal tide vertical velocity profile for each mode + write(var_name, '("Itide_Wstruct","_mode",i1)') m + write(var_descript, '("vertical velocity profile for mode ",i1)') m + CS%id_Wstruct_mode(m) = register_diag_field('ocean_model', var_name, & + diag%axesTi, Time, var_descript, '[]') + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + + write(var_name, '("Itide_int_w2","_mode",i1)') m + write(var_descript, '("integral of w2 for mode ",i1)') m + CS%id_int_w2_mode(m) = register_diag_field('ocean_model', var_name, & + diag%axesT1, Time, var_descript, 'm', conversion=US%Z_to_m) + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + + write(var_name, '("Itide_int_U2","_mode",i1)') m + write(var_descript, '("integral of U2 for mode ",i1)') m + CS%id_int_U2_mode(m) = register_diag_field('ocean_model', var_name, & + diag%axesT1, Time, var_descript, 'm-1', conversion=US%m_to_L) + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + + write(var_name, '("Itide_int_N2w2","_mode",i1)') m + write(var_descript, '("integral of N2w2 for mode ",i1)') m + CS%id_int_N2w2_mode(m) = register_diag_field('ocean_model', var_name, & + diag%axesT1, Time, var_descript, 'm s-2', conversion=US%Z_to_m*US%s_to_T**2) + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + + enddo + + ! Initialize the module that calculates the wave speeds. + call wave_speed_init(CS%wave_speed, c1_thresh=IGW_c1_thresh) end subroutine internal_tides_init @@ -2670,6 +2837,12 @@ subroutine internal_tides_end(CS) if (allocated(CS%id_En_mode)) deallocate(CS%id_En_mode) if (allocated(CS%id_Ub_mode)) deallocate(CS%id_Ub_mode) if (allocated(CS%id_cp_mode)) deallocate(CS%id_cp_mode) + if (allocated(CS%id_Ustruct_mode)) deallocate(CS%id_Ustruct_mode) + if (allocated(CS%id_Wstruct_mode)) deallocate(CS%id_Wstruct_mode) + if (allocated(CS%id_int_w2_mode)) deallocate(CS%id_int_w2_mode) + if (allocated(CS%id_int_U2_mode)) deallocate(CS%id_int_U2_mode) + if (allocated(CS%id_int_N2w2_mode)) deallocate(CS%id_int_N2w2_mode) + end subroutine internal_tides_end end module MOM_internal_tides diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index fe31eb0de3..206773ecb0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -10,6 +10,7 @@ module MOM_mixed_layer_restrat use MOM_domains, only : pass_var, To_West, To_South, Omit_Corners use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_forcing_type, only : mech_forcing use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type @@ -27,6 +28,7 @@ module MOM_mixed_layer_restrat public mixedlayer_restrat public mixedlayer_restrat_init public mixedlayer_restrat_register_restarts +public mixedlayer_restrat_unit_tests ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -57,7 +59,31 @@ module MOM_mixed_layer_restrat !! the mixed-layer [nondim]. real :: MLE_MLD_stretch !< A scaling coefficient for stretching/shrinking the MLD used in !! the MLE scheme [nondim]. This simply multiplies MLD wherever used. + + ! The following parameters are used in the Bodner et al., 2023, parameterization + logical :: use_Bodner = .false. !< If true, use the Bodner et al., 2023, parameterization. + real :: Cr !< Efficiency coefficient from Bodner et al., 2023 [nondim] + real :: mstar !< The m* value used to estimate the turbulent vertical momentum flux [nondim] + real :: nstar !< The n* value used to estimate the turbulent vertical momentum flux [nondim] + real :: min_wstar2 !< The minimum lower bound to apply to the vertical momentum flux, + !! w'u', in the Bodner et al., restratification parameterization + !! [m2 s-2]. This avoids a division-by-zero in the limit when u* + !! and the buoyancy flux are zero. + real :: BLD_growing_Tfilt !< The time-scale for a running-mean filter applied to the boundary layer + !! depth (BLD) when the BLD is deeper than the running mean [T ~> s]. + !! A value of 0 instantaneously sets the running mean to the current value of BLD. + real :: BLD_decaying_Tfilt !< The time-scale for a running-mean filter applied to the boundary layer + !! depth (BLD) when the BLD is shallower than the running mean [T ~> s]. + !! A value of 0 instantaneously sets the running mean to the current value of BLD. + real :: MLD_decaying_Tfilt !< The time-scale for a running-mean filter applied to the time-filtered + !! MLD, when the latter is shallower than the running mean [T ~> s]. + !! A value of 0 instantaneously sets the running mean to the current value of MLD. + real :: MLD_growing_Tfilt !< The time-scale for a running-mean filter applied to the time-filtered + !! MLD, when the latter is deeper than the running mean [T ~> s]. + !! A value of 0 instantaneously sets the running mean to the current value of MLD. + logical :: debug = .false. !< If true, calculate checksums of fields for debugging. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance @@ -67,7 +93,8 @@ module MOM_mixed_layer_restrat real, dimension(:,:), allocatable :: & MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] - MLD_filtered_slow !< Slower time-filtered MLD [H ~> m or kg m-2] + MLD_filtered_slow, & !< Slower time-filtered MLD [H ~> m or kg m-2] + wpup_filtered !< Time-filtered vertical momentum flux [Z2 T-2 ~> m2 s-2] !>@{ !! Diagnostic identifier @@ -76,11 +103,15 @@ module MOM_mixed_layer_restrat integer :: id_uhml = -1 integer :: id_vhml = -1 integer :: id_MLD = -1 + integer :: id_BLD = -1 integer :: id_Rml = -1 integer :: id_uDml = -1 integer :: id_vDml = -1 integer :: id_uml = -1 integer :: id_vml = -1 + integer :: id_wpup = -1 + integer :: id_ustar = -1 + integer :: id_bflux = -1 !>@} end type mixedlayer_restrat_CS @@ -92,7 +123,7 @@ module MOM_mixed_layer_restrat !> Driver for the mixed-layer restratification parameterization. !! The code branches between two different implementations depending !! on whether the bulk-mixed layer or a general coordinate are in use. -subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, bflux, VarMix, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -106,22 +137,29 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! planetary boundary layer scheme [Z ~> m] + real, dimension(:,:), pointer :: bflux !< Surface buoyancy flux provided by the + !! PBL scheme [Z2 T-3 ~> m2 s-3] type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "mixedlayer_restrat: "// & "Module must be initialized before it is used.") if (GV%nkml>0) then + ! Original form, written for the isopycnal model with a bulk mixed layer call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) + elseif (CS%use_Bodner) then + ! Implementation of Bodner et al., 2023 + call mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, MLD, bflux) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) + ! Implementation of Fox-Kemper et al., 2008, to work in general coordinates + call mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat -!> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) +!> Calculates a restratifying flow in the mixed layer, following the formulation used in OM4 +subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -210,10 +248,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var vonKar_x_pi2 = CS%vonKar * 9.8696 - if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// & "An equation of state must be used with this module.") if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & - call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// & "The resolution argument, Rd/dx, was not associated.") if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. @@ -222,7 +260,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var EOSdom(:) = EOS_domain(G%HI, halo=1) do j = js-1, je+1 dK(:) = 0.5 * h(:,j,1) ! Depth of center of surface layer - if (CS%use_stanley_ml) then + if (CS%use_Stanley_ML) then call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, tv%varT(:,j,1), covTS, varS, & rhoSurf, tv%eqn_of_state, EOSdom) else @@ -235,7 +273,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var dK(:) = dK(:) + 0.5 * ( h(:,j,k) + h(:,j,k-1) ) ! Depth of center of layer K ! Mixed-layer depth, using sigma-0 (surface reference pressure) deltaRhoAtKm1(:) = deltaRhoAtK(:) ! Store value from previous iteration of K - if (CS%use_stanley_ml) then + if (CS%use_Stanley_ML) then call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, tv%varT(:,j,k), covTS, varS, & deltaRhoAtK, tv%eqn_of_state, EOSdom) else @@ -264,7 +302,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var MLD_fast(i,j) = (CS%MLE_MLD_stretch * GV%Z_to_H) * MLD_in(i,j) enddo ; enddo else - call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// & "No MLD to use for MLE parameterization.") endif @@ -337,7 +375,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then - if (CS%use_stanley_ml) then + if (CS%use_Stanley_ML) then call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, & rho_ml(:), tv%eqn_of_state, EOSdom) else @@ -432,9 +470,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! The sum of a(k) through the mixed layers must be 0. do k=1,nz hAtVel = 0.5*(h(i,j,k) + h(i+1,j,k)) - a(k) = PSI(zpa) ! Psi(z/MLD) for upper interface - zpa = zpa - (hAtVel * IhTot) ! z/H for lower interface - a(k) = a(k) - PSI(zpa) ! Transport profile + a(k) = mu(zpa, CS%MLE_tail_dh) ! mu(z/MLD) for upper interface + zpa = zpa - (hAtVel * IhTot) ! z/H for lower interface + a(k) = a(k) - mu(zpa, CS%MLE_tail_dh) ! Transport profile ! Limit magnitude (uDml) if it would violate CFL if (a(k)*uDml(I) > 0.0) then if (a(k)*uDml(I) > h_avail(i,j,k)) uDml(I) = h_avail(i,j,k) / a(k) @@ -445,9 +483,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var do k=1,nz ! Transport for slow-filtered MLD hAtVel = 0.5*(h(i,j,k) + h(i+1,j,k)) - b(k) = PSI(zpb) ! Psi(z/MLD) for upper interface - zpb = zpb - (hAtVel * IhTot_slow) ! z/H for lower interface - b(k) = b(k) - PSI(zpb) ! Transport profile + b(k) = mu(zpb, CS%MLE_tail_dh) ! mu(z/MLD) for upper interface + zpb = zpb - (hAtVel * IhTot_slow) ! z/H for lower interface + b(k) = b(k) - mu(zpb, CS%MLE_tail_dh) ! Transport profile ! Limit magnitude (uDml_slow) if it would violate CFL when added to uDml if (b(k)*uDml_slow(I) > 0.0) then if (b(k)*uDml_slow(I) > h_avail(i,j,k) - a(k)*uDml(I)) & @@ -519,9 +557,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! The sum of a(k) through the mixed layers must be 0. do k=1,nz hAtVel = 0.5*(h(i,j,k) + h(i,j+1,k)) - a(k) = PSI( zpa ) ! Psi(z/MLD) for upper interface - zpa = zpa - (hAtVel * IhTot) ! z/H for lower interface - a(k) = a(k) - PSI( zpa ) ! Transport profile + a(k) = mu(zpa, CS%MLE_tail_dh) ! mu(z/MLD) for upper interface + zpa = zpa - (hAtVel * IhTot) ! z/H for lower interface + a(k) = a(k) - mu(zpa, CS%MLE_tail_dh) ! Transport profile ! Limit magnitude (vDml) if it would violate CFL if (a(k)*vDml(i) > 0.0) then if (a(k)*vDml(i) > h_avail(i,j,k)) vDml(i) = h_avail(i,j,k) / a(k) @@ -532,9 +570,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var do k=1,nz ! Transport for slow-filtered MLD hAtVel = 0.5*(h(i,j,k) + h(i,j+1,k)) - b(k) = PSI(zpb) ! Psi(z/MLD) for upper interface - zpb = zpb - (hAtVel * IhTot_slow) ! z/H for lower interface - b(k) = b(k) - PSI(zpb) ! Transport profile + b(k) = mu(zpb, CS%MLE_tail_dh) ! mu(z/MLD) for upper interface + zpb = zpb - (hAtVel * IhTot_slow) ! z/H for lower interface + b(k) = b(k) - mu(zpb, CS%MLE_tail_dh) ! Transport profile ! Limit magnitude (vDml_slow) if it would violate CFL when added to vDml if (b(k)*vDml_slow(i) > 0.0) then if (b(k)*vDml_slow(i) > h_avail(i,j,k) - a(k)*vDml(i)) & @@ -575,7 +613,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_vrestrat_time > 0) call post_data(CS%id_vrestrat_time, vtimescale_diag, CS%diag) if (CS%id_uhml > 0) call post_data(CS%id_uhml, uhml, CS%diag) if (CS%id_vhml > 0) call post_data(CS%id_vhml, vhml, CS%diag) - if (CS%id_MLD > 0) call post_data(CS%id_MLD, MLD_fast, CS%diag) + if (CS%id_BLD > 0) call post_data(CS%id_BLD, MLD_fast, CS%diag) + if (CS%id_MLD > 0) call post_data(CS%id_MLD, MLD_slow, CS%diag) if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rml_av_fast, CS%diag) if (CS%id_uDml > 0) call post_data(CS%id_uDml, uDml_diag, CS%diag) if (CS%id_vDml > 0) call post_data(CS%id_vDml, vDml_diag, CS%diag) @@ -583,14 +622,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_uml > 0) then do J=js,je ; do i=is-1,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) - uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) + uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (mu(0.,0.)-mu(-.01,0.)) enddo ; enddo call post_data(CS%id_uml, uDml_diag, CS%diag) endif if (CS%id_vml > 0) then do J=js-1,je ; do i=is,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) - vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) + vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (mu(0.,0.)-mu(-.01,0.)) enddo ; enddo call post_data(CS%id_vml, vDml_diag, CS%diag) endif @@ -600,25 +639,397 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! This needs to happen after the H update and before the next post_data. call diag_update_remap_grids(CS%diag) -contains - !> Stream function [nondim] as a function of non-dimensional position within mixed-layer - real function psi(z) - real, intent(in) :: z !< Fractional mixed layer depth [nondim] - real :: psi1 ! The streamfunction structure without the tail [nondim] - real :: bottop, xp, dd ! Local work variables used to generate the streamfunction tail [nondim] +end subroutine mixedlayer_restrat_OM4 + +!> Stream function shape as a function of non-dimensional position within mixed-layer [nondim] +real function mu(sigma, dh) + real, intent(in) :: sigma !< Fractional position within mixed layer [nondim] + !! z=0 is surface, z=-1 is the bottom of the mixed layer + real, intent(in) :: dh !< Non-dimensional distance over which to extend stream + !! function to smooth transport at base [nondim] + ! Local variables + real :: xp !< A linear function from mid-point of the mixed-layer + !! to the extended mixed-layer bottom [nondim] + real :: bottop !< A mask, 0 in upper half of mixed layer, 1 otherwise [nondim] + real :: dd !< A cubic(-ish) profile in lower half of extended mixed + !! layer to smooth out the parameterized transport [nondim] + + ! Lower order shape (not used), see eq 10 from FK08b. + ! Apparently used in CM2G, see eq 14 of FK11. + !mu = max(0., (1. - (2.*sigma + 1.)**2)) + + ! Second order, in Rossby number, shape. See eq 21 from FK08a, eq 9 from FK08b, eq 5 FK11 + mu = max(0., (1. - (2.*sigma + 1.)**2) * (1. + (5./21.)*(2.*sigma + 1.)**2)) + + ! -0.5 < sigma : xp(sigma)=0 (upper half of mixed layer) + ! -1.0+dh < sigma < -0.5 : xp(sigma)=linear (lower half +dh of mixed layer) + ! sigma < -1.0+dh : xp(sigma)=1 (below mixed layer + dh) + xp = max(0., min(1., (-sigma - 0.5)*2. / (1. + 2.*dh))) + + ! -0.5 < sigma : dd(sigma)=1 (upper half of mixed layer) + ! -1.0+dh < sigma < -0.5 : dd(sigma)=cubic (lower half +dh of mixed layer) + ! sigma < -1.0+dh : dd(sigma)=0 (below mixed layer + dh) + dd = (max(1. - xp**2 * (3. - 2.*xp), 0.))**(1. + 2.*dh) + + ! -0.5 < sigma : bottop(sigma)=0 (upper half of mixed layer) + ! sigma < -0.5 : bottop(sigma)=1 (below upper half) + bottop = 0.5*(1. - sign(1., sigma + 0.5)) ! =0 for sigma>-0.5, =1 for sigma<-0.5 + + mu = max(mu, dd*bottop) ! Combines original psi1 with tail +end function mu + +!> Calculates a restratifying flow in the mixed layer, following the formulation +!! used in Bodner et al., 2023 (B22) +subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, BLD, bflux) + ! Arguments + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H L2 ~> m3 or kg] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + real, dimension(:,:), pointer :: BLD !< Active boundary layer depth provided by the + !! PBL scheme [Z ~> m] (not H) + real, dimension(:,:), pointer :: bflux !< Surface buoyancy flux provided by the + !! PBL scheme [Z2 T-3 ~> m2 s-3] + ! Local variables + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vol_dt_avail(SZI_(G),SZJ_(G),SZK_(GV)) ! The volume available for exchange out of each face of + ! each layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJ_(G)) :: & + little_h, & ! "Little h" representing active mixing layer depth [Z ~> m] + big_H, & ! "Big H" representing the mixed layer depth [Z ~> m] + htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] + buoy_av, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + wpup ! Turbulent vertical momentum [ ????? ~> m2 s-2] + real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: covTS(SZI_(G)) ! SGS TS covariance in Stanley param; currently 0 [degC ppt] + real :: varS(SZI_(G)) ! SGS S variance in Stanley param; currently 0 [ppt2] + real :: dmu(SZK_(GV)) ! Change in mu(z) across layer k [nondim] + real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] + real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa] + real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] + real :: h_vel ! htot interpolated onto velocity points [H ~> m or kg m-2] + real :: w_star3 ! Cube of turbulent convective velocity [m3 s-3] + real :: u_star3 ! Cube of surface fruction velocity [m3 s-3] + real :: r_wpup ! reciprocal of vertical momentum flux [Z-2 T2 ~> m-2 s2] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: grid_dsd ! combination of grid scales [L2 ~> m2] + real :: h_sml ! "Little h", the active mixing depth with diurnal cycle removed [Z ~> m] + real :: h_big ! "Big H", the mixed layer depth based on a time filtered "little h" [Z ~> m] + real :: grd_b ! The vertically average gradient of buoyancy [L Z-1 T-2 ~> s-2] + real :: psi_mag ! Magnitude of stream function [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] + real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] + real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] + real :: sigint ! Fractional position within the mixed layer of the interface above a layer [nondim] + real :: muzb ! mu(z) at bottom of the layer [nondim] + real :: muza ! mu(z) at top of the layer [nondim] + real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] + real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] + real, parameter :: two_thirds = 2./3. + logical :: line_is_empty, keep_going + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + I4dt = 0.25 / dt + g_Rho0 = GV%g_Earth / GV%Rho0 + h_neglect = GV%H_subroundoff - !psi1 = max(0., (1. - (2.*z + 1.)**2)) - psi1 = max(0., (1. - (2.*z + 1.)**2) * (1. + (5./21.)*(2.*z + 1.)**2)) + covTS(:) = 0.0 ! Might be in tv% in the future. Not implemented for the time being. + varS(:) = 0.0 ! Ditto. - xp = max(0., min(1., (-z - 0.5)*2. / (1. + 2.*CS%MLE_tail_dh))) - dd = (1. - 3.*(xp**2) + 2.*(xp**3))**(1. + 2.*CS%MLE_tail_dh) - bottop = 0.5*(1. - sign(1., z + 0.5)) ! =0 for z>-0.5, =1 for z<-0.5 + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "mixedlayer_restrat_Bodner: "// & + "An equation of state must be used with this module.") + if (.not.CS%MLE_use_PBL_MLD) call MOM_error(FATAL, "mixedlayer_restrat_Bodner: "// & + "To use the Bodner et al., 2023, MLE parameterization, MLE_USE_PBL_MLD must be True.") + if (CS%MLE_density_diff > 0.) call MOM_error(FATAL, "mixedlayer_restrat_Bodner: "// & + "MLE_density_diff is +ve and should not be in mixedlayer_restrat_Bodner.") + if (.not.associated(bflux)) call MOM_error(FATAL, "mixedlayer_restrat_Bodner: "// & + "Surface buoyancy flux was not associated.") + + call pass_var(bflux, G%domain, halo=1) + + if (CS%debug) then + call hchksum(h,'mixed_Bodner: h', G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(BLD, 'mle_Bodner: BLD in', G%HI, haloshift=1, scale=US%Z_to_m) + if (associated(bflux)) & + call hchksum(bflux, 'mle_Bodner: bflux', G%HI, haloshift=1, scale=US%Z_to_m**2*US%s_to_T**3) + call hchksum(forces%ustar,'mle_Bodner: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) + call hchksum(CS%MLD_filtered, 'mle_Bodner: MLD_filtered 1', & + G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(CS%MLD_filtered_slow,'mle_Bodner: MLD_filtered_slow 1', & + G%HI, haloshift=1, scale=US%Z_to_m) + endif + + ! Apply time filter to BLD (to remove diurnal cycle) to obtain "little h". + ! "little h" is representative of the active mixing layer depth, used in B22 formula (eq 27). + do j = js-1, je+1 ; do i = is-1, ie+1 + little_h(i,j) = rmean2ts(BLD(i,j), CS%MLD_filtered(i,j), & + CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt) + CS%MLD_filtered(i,j) = little_h(i,j) + enddo ; enddo - psi = max(psi1, dd*bottop) ! Combines original psi1 with tail - end function psi + ! Calculate "big H", representative of the mixed layer depth, used in B22 formula (eq 27). + do j = js-1, je+1 ; do i = is-1, ie+1 + big_H(i,j) = rmean2ts(little_h(i,j), CS%MLD_filtered_slow(i,j), & + CS%MLD_growing_Tfilt, CS%MLD_decaying_Tfilt, dt) + CS%MLD_filtered_slow(i,j) = big_H(i,j) + enddo ; enddo -end subroutine mixedlayer_restrat_general + ! Estimate w'u' at h-points + do j = js-1, je+1 ; do i = is-1, ie+1 + w_star3 = max(0., -bflux(i,j)) * BLD(i,j) & ! (this line in Z3 T-3 ~> m3 s-3) + * ( ( US%Z_to_m * US%s_to_T )**3 ) ! m3 s-3 + u_star3 = ( US%Z_to_m * US%s_to_T * forces%ustar(i,j) )**3 ! m3 s-3 + wpup(i,j) = max( CS%min_wstar2, & ! The max() avoids division by zero later + ( CS%mstar * u_star3 + CS%nstar * w_star3 )**two_thirds ) & ! (this line m2 s-2) + * ( ( US%m_to_Z * US%T_to_s )**2 ) ! Z2 T-2 ~> m2 s-2 + ! We filter w'u' with the same time scales used for "little h" + wpup(i,j) = rmean2ts(wpup(i,j), CS%wpup_filtered(i,j), & + CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt) + CS%wpup_filtered(i,j) = wpup(i,j) + enddo ; enddo + if (CS%debug) then + call hchksum(little_h,'mle_Bodner: little_h', G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(big_H,'mle_Bodner: big_H', G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(CS%MLD_filtered,'mle_Bodner: MLD_filtered 2', & + G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(CS%MLD_filtered_slow,'mle_Bodner: MLD_filtered_slow 2', & + G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(wpup,'mle_Bodner: wpup', G%HI, haloshift=1, scale=(US%Z_to_m*US%s_to_T)**2) + endif + + ! Calculate the average density in the "mixed layer". + ! Notice we use p=0 (sigma_0) since horizontal differences of vertical averages of + ! in-situ density would contain the MLD gradient (through the pressure dependence). + p0(:) = 0.0 + EOSdom(:) = EOS_domain(G%HI, halo=1) + !$OMP parallel & + !$OMP default(shared) & + !$OMP private(i, j, k, keep_going, line_is_empty, dh, & + !$OMP grid_dsd, absf, h_sml, h_big, grd_b, r_wpup, psi_mag, IhTot, & + !$OMP sigint, muzb, muza, hAtVel) + !$OMP do + do j=js-1,je+1 + do i=is-1,ie+1 + htot(i,j) = 0.0 ; buoy_av(i,j) = 0.0 + enddo + keep_going = .true. + do k=1,nz + do i=is-1,ie+1 + vol_dt_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + enddo + if (keep_going) then + if (CS%use_Stanley_ML) then + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, & + rho_ml(:), tv%eqn_of_state, EOSdom) + else + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom) + endif + line_is_empty = .true. + do i=is-1,ie+1 + if (htot(i,j) < big_H(i,j)*GV%Z_to_H) then + dh = min( h(i,j,k), big_H(i,j)*GV%Z_to_H - htot(i,j) ) + buoy_av(i,j) = buoy_av(i,j) + dh*rho_ml(i) ! Here, buoy_av has units of R H ~> kg m-2 + htot(i,j) = htot(i,j) + dh + line_is_empty = .false. + endif + enddo + if (line_is_empty) keep_going=.false. + endif + enddo + + do i=is-1,ie+1 + ! Hereafter, buoy_av has units (L2 Z-1 T-2 R-1) * (R H) * H-1 = L2 Z-1 T-2 ~> m s-2 + buoy_av(i,j) = -( g_Rho0 * buoy_av(i,j) ) / (htot(i,j) + h_neglect) + enddo + enddo + + if (CS%debug) then + call hchksum(htot,'mle_Bodner: htot', G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(vol_dt_avail,'mle_Bodner: vol_dt_avail', G%HI, haloshift=1, & + scale=US%L_to_m**2*GV%H_to_m*US%s_to_T) + call hchksum(buoy_av,'mle_Bodner: buoy_av', G%HI, haloshift=1, & + scale=US%m_to_Z*US%L_T_to_m_s**2) + endif + + ! U - Component + !$OMP do + do j=js,je ; do I=is-1,ie + if (G%OBCmaskCu(I,j) > 0.) then + grid_dsd = sqrt(0.5*( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 )) * G%dyCu(I,j) ! L2 ~> m2 + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! T-1 ~> s-1 + h_sml = 0.5*( little_h(i,j) + little_h(i+1,j) ) ! Z ~> m + h_big = 0.5*( big_H(i,j) + big_H(i+1,j) ) ! Z ~> m + grd_b = ( buoy_av(i+1,j) - buoy_av(i,j) ) * G%IdxCu(I,j) ! L Z-1 T-2 ~> s-2 + r_wpup = 2. / ( wpup(i,j) + wpup(i+1,j) ) ! Z-2 T2 ~> m-2 s2 + psi_mag = ( ( ( CS%Cr * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1 + * ( ( h_big**2 ) * grd_b ) ) * r_wpup * US%L_to_Z * GV%Z_to_H + else ! There is no flux on land and no gradient at open boundary points. + psi_mag = 0.0 + endif + + IhTot = 2.0 / ((htot(i,j) + htot(i+1,j)) + h_neglect) ! [H-1] + sigint = 0.0 + muzb = 0.0 ! This will be the first value of muza = mu(z=0) + do k=1,nz + muza = muzb ! mu(z/MLD) for upper interface [nondim] + hAtVel = 0.5*(h(i,j,k) + h(i+1,j,k)) ! Thickness at velocity point [H] + sigint = sigint - (hAtVel * IhTot) ! z/H for lower interface [nondim] + muzb = mu(sigint, CS%MLE_tail_dh) ! mu(z/MLD) for lower interface [nondim] + dmu(k) = muza - muzb ! Change in mu(z) across layer [nondim] + ! dmu(k)*psi_mag is the transport in this layer [L2 H T-1 ~> m3 s-1] + ! Limit magnitude (psi_mag) if it would violate CFL + if (dmu(k)*psi_mag > 0.0) then + if (dmu(k)*psi_mag > vol_dt_avail(i,j,k)) psi_mag = vol_dt_avail(i,j,k) / dmu(k) + elseif (dmu(k)*psi_mag < 0.0) then + if (-dmu(k)*psi_mag > vol_dt_avail(i+1,j,k)) psi_mag = -vol_dt_avail(i+1,j,k) / dmu(k) + endif + enddo ! These loops cannot be fused because psi_mag applies to the whole column + do k=1,nz + uhml(I,j,k) = dmu(k) * psi_mag ! [ L2 H T-1 ] + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k) * dt ! [ L2 H ] + enddo + + uDml_diag(I,j) = psi_mag + enddo ; enddo + + ! V- component + !$OMP do + do J=js-1,je ; do i=is,ie + if (G%OBCmaskCv(i,J) > 0.) then + grid_dsd = sqrt(0.5*( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 )) * G%dxCv(i,J) ! L2 ~> m2 + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! T-1 ~> s-1 + h_sml = 0.5*( little_h(i,j) + little_h(i,j+1) ) ! Z ~> m + h_big = 0.5*( big_H(i,j) + big_H(i,j+1) ) ! Z ~> m + grd_b = ( buoy_av(i,j+1) - buoy_av(i,j) ) * G%IdyCv(I,j) ! L Z-1 T-2 ~> s-2 + r_wpup = 2. / ( wpup(i,j) + wpup(i,j+1) ) ! Z-2 T2 ~> m-2 s2 + psi_mag = ( ( ( CS%Cr * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1 + * ( ( h_big**2 ) * grd_b ) ) * r_wpup * US%L_to_Z * GV%Z_to_H + else ! There is no flux on land and no gradient at open boundary points. + psi_mag = 0.0 + endif + + IhTot = 2.0 / ((htot(i,j) + htot(i,j+1)) + h_neglect) ! [H-1] + sigint = 0.0 + muzb = 0.0 ! This will be the first value of muza = mu(z=0) + do k=1,nz + muza = muzb ! mu(z/MLD) for upper interface [nondim] + hAtVel = 0.5*(h(i,j,k) + h(i,j+1,k)) ! Thickness at velocity point [H] + sigint = sigint - (hAtVel * IhTot) ! z/H for lower interface [nondim] + muzb = mu(sigint, CS%MLE_tail_dh) ! mu(z/MLD) for lower interface [nondim] + dmu(k) = muza - muzb ! Change in mu(z) across layer [nondim] + ! dmu(k)*psi_mag is the transport in this layer [L2 H T-1 ~> m3 s-1] + ! Limit magnitude (psi_mag) if it would violate CFL + if (dmu(k)*psi_mag > 0.0) then + if (dmu(k)*psi_mag > vol_dt_avail(i,j,k)) psi_mag = vol_dt_avail(i,j,k) / dmu(k) + elseif (dmu(k)*psi_mag < 0.0) then + if (-dmu(k)*psi_mag > vol_dt_avail(i,j+1,k)) psi_mag = -vol_dt_avail(i,j+1,k) / dmu(k) + endif + enddo ! These loops cannot be fused because psi_mag applies to the whole column + do k=1,nz + vhml(i,J,k) = dmu(k) * psi_mag ! [ L2 H T-1 ] + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k) * dt ! [ L2 H ] + enddo + + vDml_diag(i,J) = psi_mag + enddo ; enddo + + !$OMP do + do j=js,je ; do k=1,nz ; do i=is,ie + h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) + enddo ; enddo ; enddo + !$OMP end parallel + + if (CS%id_uhml > 0 .or. CS%id_vhml > 0) & + ! Remapped uhml and vhml require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! Offer diagnostic fields for averaging. + if (query_averaging_enabled(CS%diag)) then + if (CS%id_ustar > 0) call post_data(CS%id_ustar, forces%ustar, CS%diag) + if (CS%id_bflux > 0) call post_data(CS%id_bflux, bflux, CS%diag) + if (CS%id_wpup > 0) call post_data(CS%id_wpup, wpup, CS%diag) + if (CS%id_Rml > 0) call post_data(CS%id_Rml, buoy_av, CS%diag) + if (CS%id_BLD > 0) call post_data(CS%id_BLD, little_h, CS%diag) + if (CS%id_MLD > 0) call post_data(CS%id_MLD, big_H, CS%diag) + if (CS%id_uhml > 0) call post_data(CS%id_uhml, uhml, CS%diag) + if (CS%id_vhml > 0) call post_data(CS%id_vhml, vhml, CS%diag) + if (CS%id_uDml > 0) call post_data(CS%id_uDml, uDml_diag, CS%diag) + if (CS%id_vDml > 0) call post_data(CS%id_vDml, vDml_diag, CS%diag) + + if (CS%id_uml > 0) then + do J=js,je ; do i=is-1,ie + h_vel = 0.5*((htot(i,j) + htot(i+1,j)) + h_neglect) + uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (mu(0.,0.)-mu(-.01,0.)) + enddo ; enddo + call post_data(CS%id_uml, uDml_diag, CS%diag) + endif + if (CS%id_vml > 0) then + do J=js-1,je ; do i=is,ie + h_vel = 0.5*((htot(i,j) + htot(i,j+1)) + h_neglect) + vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (mu(0.,0.)-mu(-.01,0.)) + enddo ; enddo + call post_data(CS%id_vml, vDml_diag, CS%diag) + endif + endif + +end subroutine mixedlayer_restrat_Bodner + +!> Two time-scale running mean [units of "signal" and "filtered"] +!! +!! If signal > filtered, returns running-mean with time scale "tau_growing". +!! If signal <= filtered, returns running-mean with time scale "tau_decaying". +!! +!! The running mean of \f$ s \f$ with time scale "of \f$ \tau \f$ is: +!! \f[ +!! \bar{s} <- ( \Delta t * s + \tau * \bar{s} ) / ( \Delta t + \tau ) +!! \f] +!! +!! Note that if \f$ tau=0 \f$, then the running mean equals the signal. Thus, +!! rmean2ts with tau_growing=0 recovers the "resetting running mean" used in OM4. +real elemental function rmean2ts(signal, filtered, tau_growing, tau_decaying, dt) + ! Arguments + real, intent(in) :: signal ! Unfiltered signal [arbitrary units] + real, intent(in) :: filtered ! Current value of running mean [arbitrary units] + real, intent(in) :: tau_growing ! Time scale for growing signal [T ~> s] + real, intent(in) :: tau_decaying ! Time scale for decaying signal [T ~> s] + real, intent(in) :: dt ! Time step [T ~> s] + ! Local variables + real :: afac, bfac ! Non-dimensional weights + real :: rt ! Reciprocal time scale [T-1 ~> s-1] + + if (signal>=filtered) then + rt = 1.0 / ( dt + tau_growing ) + aFac = tau_growing * rt + bFac = 1. - aFac + else + rt = 1.0 / ( dt + tau_decaying ) + aFac = tau_decaying * rt + bFac = 1. - aFac + endif + + rmean2ts = aFac * filtered + bFac * signal + +end function rmean2ts !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) @@ -678,7 +1089,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nkml = GV%nkml - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "mixedlayer_restrat_BML: "// & "Module must be initialized before it is used.") if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return @@ -693,12 +1104,11 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z - if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not.use_EOS) call MOM_error(FATAL, "mixedlayer_restrat_BML: "// & "An equation of state must be used with this module.") - if (CS%use_stanley_ml) call MOM_error(FATAL, & - "MOM_mixedlayer_restrat: The Stanley parameterization is not"//& - "available with the BML.") + if (CS%use_Stanley_ML) call MOM_error(FATAL, "mixedlayer_restrat_BML: "// & + "The Stanley parameterization is not available with the BML.") ! Fix this later for nkml >= 3. @@ -921,13 +1331,12 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure ! Local variables - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run [nondim]? real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. [kg T s-1 H-1 L-2 ~> kg m-3 or 1] real :: omega ! The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min_dflt ! The default value for RESTRAT_USTAR_MIN [Z T-1 ~> m s-1] real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale ! temperature variance [nondim] + real :: BLD_units ! Set to either H_to_m or Z_to_m depending on scheme [m H-1 or m Z-1 ~> 1] ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j @@ -951,9 +1360,80 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%MLE_tail_dh = -9.e9 CS%MLE_use_PBL_MLD = .false. CS%MLE_MLD_stretch = -9.e9 + CS%use_Stanley_ML = .false. + CS%use_Bodner = .false. call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF", CS%ml_restrat_coef, & + call openParameterBlock(param_file,'MLE') ! Prepend MLE% to all parameters + if (GV%nkml==0) then + call get_param(param_file, mdl, "USE_BODNER23", CS%use_Bodner, & + "If true, use the Bodner et al., 2023, formulation of the re-stratifying "//& + "mixed-layer restratification parameterization. This only works in ALE mode.", & + default=.false.) + endif + if (CS%use_Bodner) then + call get_param(param_file, mdl, "CR", CS%CR, & + "The efficiency coefficient in eq 27 of Bodner et al., 2023.", & + units="nondim", default=0.0) + call get_param(param_file, mdl, "BODNER_NSTAR", CS%Nstar, & + "The n* value used to estimate the turbulent vertical momentum flux "//& + "in Bodner et al., 2023, eq. 18. This is independent of the value used in "//& + "the PBL scheme but should be set to be the same for consistency.", & + units="nondim", default=0.066) + call get_param(param_file, mdl, "BODNER_MSTAR", CS%Mstar, & + "The m* value used to estimate the turbulent vertical momentum flux "//& + "in Bodner et al., 2023, eq. 18. This is independent of the value used in "//& + "the PBL scheme but should be set to be the same for consistency.", & + units="nondim", default=0.5) + call get_param(param_file, mdl, "BLD_GROWING_TFILTER", CS%BLD_growing_Tfilt, & + "The time-scale for a running-mean filter applied to the boundary layer "//& + "depth (BLD) when the BLD is deeper than the running mean. A value of 0 "//& + "instantaneously sets the running mean to the current value of BLD.", & + units="s", default=0., scale=US%s_to_T) + call get_param(param_file, mdl, "BLD_DECAYING_TFILTER", CS%BLD_decaying_Tfilt, & + "The time-scale for a running-mean filter applied to the boundary layer "//& + "depth (BLD) when the BLD is shallower than the running mean. A value of 0 "//& + "instantaneously sets the running mean to the current value of BLD.", & + units="s", default=0., scale=US%s_to_T) + call get_param(param_file, mdl, "MLD_GROWING_TFILTER", CS%MLD_growing_Tfilt, & + "The time-scale for a running-mean filter applied to the time-filtered "//& + "BLD, when the latter is deeper than the running mean. A value of 0 "//& + "instantaneously sets the running mean to the current value filtered BLD.", & + units="s", default=0., scale=US%s_to_T) + call get_param(param_file, mdl, "MLD_DECAYING_TFILTER", CS%MLD_decaying_Tfilt, & + "The time-scale for a running-mean filter applied to the time-filtered "//& + "BLD, when the latter is shallower than the running mean. A value of 0 "//& + "instantaneously sets the running mean to the current value filtered BLD.", & + units="s", default=0., scale=US%s_to_T) + call get_param(param_file, mdl, "MIN_WSTAR2", CS%min_wstar2, & + "The minimum lower bound to apply to the vertical momentum flux, w'u', "//& + "in the Bodner et al., restratification parameterization. This avoids "//& + "a division-by-zero in the limit when u* and the buoyancy flux are zero. "//& + "The default is less than the molecular viscosity of water times the Coriolis "//& + "parameter a micron away from the equator.", & + units="m2 s-2", default=1.0e-24) + call get_param(param_file, mdl, "TAIL_DH", CS%MLE_tail_dh, & + "Fraction by which to extend the mixed-layer restratification "//& + "depth used for a smoother stream function at the base of "//& + "the mixed-layer.", units="nondim", default=0.0) + call get_param(param_file, mdl, "USE_STANLEY_TVAR", CS%use_Stanley_ML, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in ML restrat code.", default=.false.) + call closeParameterBlock(param_file) ! The remaining parameters do not have MLE% prepended + call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & + "If true, the MLE parameterization will use the mixed-layer "//& + "depth provided by the active PBL parameterization. If false, "//& + "MLE will estimate a MLD based on a density difference with the "//& + "surface using the parameter MLE_DENSITY_DIFF.", default=.false.) + if (.not.CS%MLE_use_PBL_MLD) call MOM_error(FATAL, "mixedlayer_restrat_init: "// & + "To use MLE%USE_BODNER23=True then MLE_USE_PBL_MLD must be True.") + else + call closeParameterBlock(param_file) ! The remaining parameters do not have MLE% prepended + endif + + if (.not.CS%use_Bodner) then + ! This coefficient is used in both layered and ALE versions of Fox-Kemper but not Bodner + call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF", CS%ml_restrat_coef, & "A nondimensional coefficient that is proportional to "//& "the ratio of the deformation radius to the dominant "//& "lengthscale of the submesoscale mixed layer "//& @@ -962,80 +1442,83 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "geostrophic kinetic energy or 1 plus the square of the "//& "grid spacing over the deformation radius, as detailed "//& "by Fox-Kemper et al. (2010)", units="nondim", default=0.0) - call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_stanley_ml, & - "If true, turn on Stanley SGS T variance parameterization "// & - "in ML restrat code.", default=.false.) - if (CS%use_stanley_ml) then - call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & - "Coefficient correlating the temperature gradient and SGS T variance.", & - units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) call MOM_error(FATAL, & - "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") - endif - call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & - 'The value the von Karman constant as used for mixed layer viscosity.', & - units='nondim', default=0.41) - ! We use GV%nkml to distinguish between the old and new implementation of MLE. - ! The old implementation only works for the layer model with nkml>0. - if (GV%nkml==0) then - call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF2", CS%ml_restrat_coef2, & + ! These parameters are only used in the OM4-era version of Fox-Kemper + call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_Stanley_ML, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in ML restrat code.", default=.false.) + if (CS%use_stanley_ml) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") + endif + call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) + ! We use GV%nkml to distinguish between the old and new implementation of MLE. + ! The old implementation only works for the layer model with nkml>0. + if (GV%nkml==0) then + call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF2", CS%ml_restrat_coef2, & "As for FOX_KEMPER_ML_RESTRAT_COEF but used in a second application "//& "of the MLE restratification parameterization.", units="nondim", default=0.0) - call get_param(param_file, mdl, "MLE_FRONT_LENGTH", CS%front_length, & + call get_param(param_file, mdl, "MLE_FRONT_LENGTH", CS%front_length, & "If non-zero, is the frontal-length scale used to calculate the "//& "upscaling of buoyancy gradients that is otherwise represented "//& "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is "//& "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& units="m", default=0.0, scale=US%m_to_L) - call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & + call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer "//& "depth provided by the active PBL parameterization. If false, "//& "MLE will estimate a MLD based on a density difference with the "//& "surface using the parameter MLE_DENSITY_DIFF.", default=.false.) - call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & + call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & "The time-scale for a running-mean filter applied to the mixed-layer "//& "depth used in the MLE restratification parameterization. When "//& "the MLD deepens below the current running-mean the running-mean "//& "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) - call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & + call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & "The time-scale for a running-mean filter applied to the filtered "//& "mixed-layer depth used in a second MLE restratification parameterization. "//& "When the MLD deepens below the current running-mean the running-mean "//& "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) - if (.not. CS%MLE_use_PBL_MLD) then - call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & + if (.not. CS%MLE_use_PBL_MLD) then + call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer "//& "depth used for the mixed-layer eddy parameterization "//& "by Fox-Kemper et al. (2010)", units="kg/m3", default=0.03, scale=US%kg_m3_to_R) - endif - call get_param(param_file, mdl, "MLE_TAIL_DH", CS%MLE_tail_dh, & + endif + call get_param(param_file, mdl, "MLE_TAIL_DH", CS%MLE_tail_dh, & "Fraction by which to extend the mixed-layer restratification "//& "depth used for a smoother stream function at the base of "//& "the mixed-layer.", units="nondim", default=0.0) - call get_param(param_file, mdl, "MLE_MLD_STRETCH", CS%MLE_MLD_stretch, & + call get_param(param_file, mdl, "MLE_MLD_STRETCH", CS%MLE_MLD_stretch, & "A scaling coefficient for stretching/shrinking the MLD "//& "used in the MLE scheme. This simply multiplies MLD wherever used.",& units="nondim", default=1.0) - endif - - call get_param(param_file, mdl, "KV_RESTRAT", CS%Kv_restrat, & + endif + call get_param(param_file, mdl, "KV_RESTRAT", CS%Kv_restrat, & "A small viscosity that sets a floor on the momentum mixing rate during "//& "restratification. If this is positive, it will prevent some possible "//& "divisions by zero even if ustar, RESTRAT_USTAR_MIN, and f are all 0.", & units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "OMEGA", omega, & + call get_param(param_file, mdl, "OMEGA", omega, & "The rotation rate of the earth.", & units="s-1", default=7.2921e-5, scale=US%T_to_s) - ustar_min_dflt = 2.0e-4 * omega * (GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call get_param(param_file, mdl, "RESTRAT_USTAR_MIN", CS%ustar_min, & + ustar_min_dflt = 2.0e-4 * omega * (GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) + call get_param(param_file, mdl, "RESTRAT_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that will be used by the mixed layer "//& "restratification module. This can be tiny, but if this is greater than 0, "//& "it will prevent divisions by zero when f and KV_RESTRAT are zero.", & units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) + endif CS%diag => diag flux_to_kg_per_s = GV%H_to_kg_m2 * US%L_to_m**2 * US%s_to_T + if (CS%use_Bodner) then; BLD_units = US%Z_to_m + else; BLD_units = GV%H_to_m; endif CS%id_uhml = register_diag_field('ocean_model', 'uhml', diag%axesCuL, Time, & 'Zonal Thickness Flux to Restratify Mixed Layer', & @@ -1049,10 +1532,13 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, 'Mixed Layer Meridional Restratification Timescale', 's', conversion=US%T_to_s) CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, & 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', & - 'm', conversion=GV%H_to_m) + 'm', conversion=BLD_units) + CS%id_BLD = register_diag_field('ocean_model', 'BLD_restrat', diag%axesT1, Time, & + 'Boundary Layer Depth as used in the mixed-layer restratification parameterization', & + 'm', conversion=BLD_units) CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & - 'm s2', conversion=US%m_to_Z*(US%L_T_to_m_s**2)) + 'm s-2', conversion=US%m_to_Z*(US%L_T_to_m_s**2)) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & 'Transport stream function amplitude for zonal restratification of mixed layer', & 'm3 s-1', conversion=GV%H_to_m*(US%L_to_m**2)*US%s_to_T) @@ -1065,29 +1551,21 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & 'Surface meridional velocity component of mixed layer restratification', & 'm s-1', conversion=US%L_T_to_m_s) - - ! Rescale variables from restart files if the internal dimensional scalings have changed. - if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then - if (query_initialized(CS%MLD_filtered, "MLD_MLE_filtered", restart_CS) .and. & - (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then - H_rescale = 1.0 / GV%m_to_H_restart - do j=G%jsc,G%jec ; do i=G%isc,G%iec - CS%MLD_filtered(i,j) = H_rescale * CS%MLD_filtered(i,j) - enddo ; enddo - endif - endif - if (CS%MLE_MLD_decay_time2>0.) then - if (query_initialized(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", restart_CS) .and. & - (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then - H_rescale = 1.0 / GV%m_to_H_restart - do j=G%jsc,G%jec ; do i=G%isc,G%iec - CS%MLD_filtered_slow(i,j) = H_rescale * CS%MLD_filtered_slow(i,j) - enddo ; enddo - endif + if (CS%use_Bodner) then + CS%id_wpup = register_diag_field('ocean_model', 'MLE_wpup', diag%axesT1, Time, & + 'Vertical turbulent momentum flux in Bodner mixed layer restratificiation parameterization', & + 'm2 s-2', conversion=(US%Z_to_m*US%s_to_T)**2) + CS%id_ustar = register_diag_field('ocean_model', 'MLE_ustar', diag%axesT1, Time, & + 'Surface turbulent friction velicity, u*, in Bodner mixed layer restratificiation parameterization', & + 'm s-1', conversion=(US%Z_to_m*US%s_to_T)) + CS%id_bflux = register_diag_field('ocean_model', 'MLE_bflux', diag%axesT1, Time, & + 'Surface buoyancy flux, B0, in Bodner mixed layer restratificiation parameterization', & + 'm2 s-3', conversion=(US%Z_to_m**2*US%s_to_T**3)) endif ! If MLD_filtered is being used, we need to update halo regions after a restart if (allocated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) + if (allocated(CS%MLD_filtered_slow)) call pass_var(CS%MLD_filtered_slow, G%domain) end function mixedlayer_restrat_init @@ -1102,7 +1580,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, rest type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables - logical :: mixedlayer_restrat_init + logical :: mixedlayer_restrat_init, use_Bodner ! Check to see if this module will be used call get_param(param_file, mdl, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & @@ -1113,35 +1591,117 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, rest units="s", default=0., scale=US%s_to_T, do_not_log=.true.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & units="s", default=0., scale=US%s_to_T, do_not_log=.true.) - if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then + call get_param(param_file, mdl, "MLE%USE_BODNER23", use_Bodner, & + default=.false., do_not_log=.true.) + if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0. .or. use_Bodner) then ! CS%MLD_filtered is used to keep a running mean of the PBL's actively mixed MLD. allocate(CS%MLD_filtered(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) call register_restart_field(CS%MLD_filtered, "MLD_MLE_filtered", .false., restart_CS, & longname="Time-filtered MLD for use in MLE", & units=get_thickness_units(GV), conversion=GV%H_to_MKS) endif - if (CS%MLE_MLD_decay_time2>0.) then + if (CS%MLE_MLD_decay_time2>0. .or. use_Bodner) then ! CS%MLD_filtered_slow is used to keep a running mean of the PBL's seasonal or winter MLD. allocate(CS%MLD_filtered_slow(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) - call register_restart_field(CS%MLD_filtered, "MLD_MLE_filtered_slow", .false., restart_CS, & + call register_restart_field(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", .false., restart_CS, & longname="Slower time-filtered MLD for use in MLE", & - units=get_thickness_units(GV), conversion=GV%H_to_MKS) + units=get_thickness_units(GV), conversion=GV%H_to_MKS) ! UNITS ARE WRONG -AJA + endif + if (use_Bodner) then + ! CS%MLD_filtered_slow is used to keep a running mean of the PBL's seasonal or winter MLD. + allocate(CS%wpup_filtered(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) + call register_restart_field(CS%wpup_filtered, "MLE_Bflux", .false., restart_CS, & + longname="Time-filtered vertical turbulent momentum flux for use in MLE", & + units='m2 s-2', conversion=(US%Z_to_m*US%s_to_T)**2 ) endif end subroutine mixedlayer_restrat_register_restarts +logical function mixedlayer_restrat_unit_tests(verbose) + logical, intent(in) :: verbose !< If true, write results to stdout + ! Local variables + type(mixedlayer_restrat_CS) :: CS ! Control structure + logical :: this_test + + print *,'===== mixedlayer_restrat: mixedlayer_restrat_unit_tests ==================' + + ! Tests of the shape function mu(z) + this_test = & + test_answer(verbose, mu(3.,0.), 0., 'mu(3)=0') + this_test = this_test .or. & + test_answer(verbose, mu(0.,0.), 0., 'mu(0)=0') + this_test = this_test .or. & + test_answer(verbose, mu(-0.25,0.), 0.7946428571428572, 'mu(-0.25)=0.7946...', tol=epsilon(1.)) + this_test = this_test .or. & + test_answer(verbose, mu(-0.5,0.), 1., 'mu(-0.5)=1') + this_test = this_test .or. & + test_answer(verbose, mu(-0.75,0.), 0.7946428571428572, 'mu(-0.75)=0.7946...', tol=epsilon(1.)) + this_test = this_test .or. & + test_answer(verbose, mu(-1.,0.), 0., 'mu(-1)=0') + this_test = this_test .or. & + test_answer(verbose, mu(-3.,0.), 0., 'mu(-3)=0') + this_test = this_test .or. & + test_answer(verbose, mu(-0.5,0.5), 1., 'mu(-0.5,0.5)=1') + this_test = this_test .or. & + test_answer(verbose, mu(-1.,0.5), 0.25, 'mu(-1,0.5)=0.25') + this_test = this_test .or. & + test_answer(verbose, mu(-1.5,0.5), 0., 'mu(-1.5,0.5)=0') + if (.not. this_test) print '(a)',' Passed tests of mu(z)' + mixedlayer_restrat_unit_tests = this_test + + ! Tests of the two time-scale running mean function + this_test = & + test_answer(verbose, rmean2ts(3.,2.,0.,0.,3.), 3., 'rmean2ts(3,2,0,0,3)=3') + this_test = this_test .or. & + test_answer(verbose, rmean2ts(1.,2.,0.,0.,3.), 1., 'rmean2ts(1,2,0,0,3)=1') + this_test = this_test .or. & + test_answer(verbose, rmean2ts(4.,0.,3.,0.,1.), 1., 'rmean2ts(4,0,3,0,1)=1') + this_test = this_test .or. & + test_answer(verbose, rmean2ts(0.,4.,0.,3.,1.), 3., 'rmean2ts(0,4,0,3,1)=3') + if (.not. this_test) print '(a)',' Passed tests of rmean2ts(s,f,g,d,dt)' + mixedlayer_restrat_unit_tests = mixedlayer_restrat_unit_tests .or. this_test + +end function mixedlayer_restrat_unit_tests + +!> Returns true if any cell of u and u_true are not identical. Returns false otherwise. +logical function test_answer(verbose, u, u_true, label, tol) + logical, intent(in) :: verbose !< If true, write results to stdout + real, intent(in) :: u !< Values to test + real, intent(in) :: u_true !< Values to test against (correct answer) + character(len=*), intent(in) :: label !< Message + real, optional, intent(in) :: tol !< The tolerance for differences between u and u_true + ! Local variables + real :: tolerance ! The tolerance for differences between u and u_true + integer :: k + + tolerance = 0.0 ; if (present(tol)) tolerance = tol + test_answer = .false. + + if (abs(u - u_true) > tolerance) test_answer = .true. + if (test_answer .or. verbose) then + if (test_answer) then + print '(3(a,1pe24.16),x,a,x,a)','computed =',u,' correct =',u_true, & + ' err=',u-u_true,' < wrong',label + else + print '(2(a,1pe24.16),x,a)','computed =',u,' correct =',u_true,label + endif + endif + +end function test_answer + !> \namespace mom_mixed_layer_restrat !! !! \section section_mle Mixed-layer eddy parameterization module !! -!! The subroutines in this file implement a parameterization of unresolved viscous +!! The subroutines in this module implement a parameterization of unresolved viscous !! mixed layer restratification of the mixed layer as described in Fox-Kemper et !! al., 2008, and whose impacts are described in Fox-Kemper et al., 2011. !! This is derived in part from the older parameterization that is described in !! Hallberg (Aha Hulikoa, 2003), which this new parameterization surpasses, which !! in turn is based on the sub-inertial mixed layer theory of Young (JPO, 1994). !! There is no net horizontal volume transport due to this parameterization, and -!! no direct effect below the mixed layer. +!! no direct effect below the mixed layer. A revised of the parameterization by +!! Bodner et al., 2023, is also available as an option. !! !! This parameterization sets the restratification timescale to agree with !! high-resolution studies of mixed layer restratification. @@ -1190,6 +1750,12 @@ end subroutine mixedlayer_restrat_register_restarts !! \f$ C_e \f$ is hard-coded as 0.0625. \f$ \tau \f$ is calculated from the surface friction velocity \f$ u^* \f$. !! \todo Explain expression for momentum mixing time-scale. !! +!! | Symbol | Module parameter | +!! | ---------------------------- | --------------------- | +!! | \f$ \Gamma_\Delta \f$ | FOX_KEMPER_ML_RESTRAT | +!! | \f$ l_f \f$ | MLE_FRONT_LENGTH | +!! | \f$ \Delta \rho \f$ | MLE_DENSITY_DIFF | +!! !! \subsection section_mle_filtering Time-filtering of mixed-layer depth !! !! Using the instantaneous mixed-layer depth is inconsistent with the finite life-time of @@ -1201,6 +1767,10 @@ end subroutine mixedlayer_restrat_register_restarts !! but to decay with time-scale \f$ \tau_h \f$. !! \f$ \bar{H} \f$ is substituted for \f$ H \f$ in the above equations. !! +!! | Symbol | Module parameter | +!! | ---------------------------- | --------------------- | +!! | \f$ \tau_h \f$ | MLE_MLD_DECAY_TIME | +!! !! \subsection section_mle_mld Defining the mixed-layer-depth !! !! If the parameter MLE_USE_PBL_MLD=True then the mixed-layer depth is defined/diagnosed by the @@ -1210,6 +1780,59 @@ end subroutine mixedlayer_restrat_register_restarts !! as the depth of a given density difference, \f$ \Delta \rho \f$, with the surface where the !! density difference is the parameter MLE_DENSITY_DIFF. !! +!! \subsection The Bodner (2023) modification +!! +!! To use this variant of the parameterization, set MLE\%USE_BODNER23=True which then changes the +!! available parameters. +!! MLE_USE_PBL_MLD must be True to use the B23 modification. +!! +!! Bodner et al., 2023, (B23) use an expression for the frontal width which changes the scaling from \f$ H^2 \f$ +!! to \f$ h H^2 \f$: +!! \f[ +!! {\bf \Psi} = C_r \frac{\Delta s |f| \bar{h} \bar{H}^2 \nabla \bar{b} \times \hat{\bf z} } +!! { \left( m_*u_*^3 + n_* w_*^3 \right)^{2/3} } \mu(z) +!! \f] +!! (see eq. 27 of B23). +!! Here, the \f$h\f$ is the activate boundary layer depth, and \f$H\f$ is the mixed layer depth. +!! The denominator is an approximation of the vertical turbulent momentum flux \f$\overline{w'u'}\f$ (see +!! eq. 18 of B23) calculated from the surface friction velocity \f$u_*\f$, and from the surface buoyancy flux, +!! \f$B\f$, using the relation \f$ w_*^3 \sim -B h \f$. +!! An advantage of this form of "sub-meso" is the denominator is well behaved at the equator but we apply a +!! lower bound of \f$w_{min}^2\f$ to avoid division by zero under zero forcing. +!! As for the original Fox-Kemper parameterization, \f$\nabla \bar{b}\f$ is the buoyancy gradient averaged +!! over the mixed-layer. +!! +!! The instantaneous boundary layer depth, \f$h\f$, is time filtered primarily to remove the diurnal cycle: +!! \f[ +!! \bar{h} \leftarrow \max \left( +!! \min \left( h, \frac{ \Delta t h + \tau_{h+} \bar{h} }{ \Delta t + \tau_{h+} } \right), +!! \frac{ \Delta t h + \tau_{h-} \bar{h} }{ \Delta t + \tau_{h-} } \right) +!! \f] +!! Setting \f$ \tau_{h+}=0 \f$ means that when \f$ h>\bar{h} \f$ then \f$\bar{h}\leftarrow h\f$, i.e. the +!! effective (filtered) depth, \f$\bar{h}\f$, is instantly deepened. When \f$h<\bar{h}\f$ then the effective +!! depth shoals with time-scale \f$\tau_{h-}\f$. +!! +!! A second filter is applied to \f$\bar{h}\f$ to yield and effective "mixed layer depth", \f$\bar{H}\f$, +!! defined as the deepest the boundary layer over some time-scale \f$\tau_{H-}\f$: +!! \f[ +!! \bar{H} \leftarrow \max \left( +!! \min \left( \bar{h}, \frac{ \Delta t \bar{h} + \tau_{H+} \bar{H} }{ \Delta t + \tau_{H+} } \right), +!! \frac{ \Delta t \bar{h} + \tau_{h-} \bar{H} }{ \Delta t + \tau_{H-} } \right) +!! \f] +!! Again, setting \f$ \tau_{H+}=0 \f$ allows the effective mixed layer to instantly deepend to \f$ \bar{h} \f$. +!! +!! | Symbol | Module parameter | +!! | ---------------------------- | ------------------------- | +!! | \f$ C_r \f$ | MLE\%CR | +!! | \f$ n_* \f$ | MLE\%BODNER_NSTAR | +!! | \f$ m_* \f$ | MLE\%BODNER_MSTAR | +!! | \f$ w_* \f$ | MLE\%BODNER_MSTAR | +!! | \f$ w_{min}^2 \f$ | MLE\%MIN_WSTAR2 | +!! | \f$ \tau_{h+} \f$ | MLE\%BLD_GROWING_TFILTER | +!! | \f$ \tau_{h-} \f$ | MLE\%BLD_DECAYING_TFILTER | +!! | \f$ \tau_{H+} \f$ | MLE\%MLD_GROWING_TFILTER | +!! | \f$ \tau_{H-} \f$ | MLE\%BLD_DECAYING_TFILTER | +!! !! \subsection section_mle_ref References !! !! Fox-Kemper, B., Ferrari, R. and Hallberg, R., 2008: @@ -1227,11 +1850,9 @@ end subroutine mixedlayer_restrat_register_restarts !! in global ocean climate simulations. Ocean Modell., 39(1), p61-78. !! https://doi.org/10.1016/j.ocemod.2010.09.002 !! -!! | Symbol | Module parameter | -!! | ---------------------------- | --------------------- | -!! | \f$ \Gamma_\Delta \f$ | FOX_KEMPER_ML_RESTRAT | -!! | \f$ l_f \f$ | MLE_FRONT_LENGTH | -!! | \f$ \tau_h \f$ | MLE_MLD_DECAY_TIME | -!! | \f$ \Delta \rho \f$ | MLE_DENSITY_DIFF | +!! A.S. Bodner, B. Fox-Kemper, L. Johnson, L. P. Van Roekel, J. C. McWilliams, P. P. Sullivan, P. S. Hall, +!! and J. Dong, 2023: Modifying the Mixed Layer Eddy Parameterization to Include Frontogenesis Arrest by +!! Boundary Layer Turbulence. J. Phys. Oceanogr., 53(1), p323-339. +!! https://doi.org/10.1175/JPO-D-21-0297.1 end module MOM_mixed_layer_restrat diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 584ccccc93..2a30f68b42 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -22,6 +22,7 @@ module MOM_ALE_sponge use MOM_grid, only : ocean_grid_type use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer use MOM_interpolate, only : init_external_field, get_external_field_info, time_interp_external_init +use MOM_interpolate, only : external_field use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type @@ -66,7 +67,7 @@ module MOM_ALE_sponge !> A structure for creating arrays of pointers to 3D arrays with extra gridding information type :: p3d - integer :: id !< id for FMS external time interpolator + !integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field. integer :: num_tlevs !< The number of time records contained in the file real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data [various] @@ -75,7 +76,7 @@ module MOM_ALE_sponge !> A structure for creating arrays of pointers to 2D arrays with extra gridding information type :: p2d - integer :: id !< id for FMS external time interpolator + type(external_field) :: field !< Time interpolator field handle integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file real :: scale = 1.0 !< A multiplicative factor by which to rescale input data [various] @@ -771,7 +772,6 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, !! if not given, use 'none' real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any !! contributions due to dimensional rescaling [various ~> 1]. - !! The default is 1. ! Local variables integer :: isd, ied, jsd, jed @@ -798,15 +798,15 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, ! get a unique time interp id for this field. If sponge data is on-grid, then setup ! to only read on the computational domain if (CS%spongeDataOngrid) then - CS%Ref_val(CS%fldno)%id = init_external_field(filename, fieldname, MOM_domain=G%Domain) + CS%Ref_val(CS%fldno)%field = init_external_field(filename, fieldname, MOM_domain=G%Domain) else - CS%Ref_val(CS%fldno)%id = init_external_field(filename, fieldname) + CS%Ref_val(CS%fldno)%field = init_external_field(filename, fieldname) endif CS%Ref_val(CS%fldno)%name = sp_name CS%Ref_val(CS%fldno)%long_name = long_name CS%Ref_val(CS%fldno)%unit = unit fld_sz(1:4) = -1 - call get_external_field_info(CS%Ref_val(CS%fldno)%id, size=fld_sz) + call get_external_field_info(CS%Ref_val(CS%fldno)%field, size=fld_sz) nz_data = fld_sz(3) CS%Ref_val(CS%fldno)%nz_data = nz_data !< individual sponge fields may reside on a different vertical grid CS%Ref_val(CS%fldno)%num_tlevs = fld_sz(4) @@ -899,23 +899,23 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename ! containing time-interpolated values from an external file corresponding ! to the current model date. if (CS%spongeDataOngrid) then - CS%Ref_val_u%id = init_external_field(filename_u, fieldname_u, domain=G%Domain%mpp_domain) + CS%Ref_val_u%field = init_external_field(filename_u, fieldname_u, domain=G%Domain%mpp_domain) else - CS%Ref_val_u%id = init_external_field(filename_u, fieldname_u) + CS%Ref_val_u%field = init_external_field(filename_u, fieldname_u) endif fld_sz(1:4) = -1 - call get_external_field_info(CS%Ref_val_u%id, size=fld_sz) + call get_external_field_info(CS%Ref_val_u%field, size=fld_sz) CS%Ref_val_u%nz_data = fld_sz(3) CS%Ref_val_u%num_tlevs = fld_sz(4) CS%Ref_val_u%scale = US%m_s_to_L_T ; if (present(scale)) CS%Ref_val_u%scale = scale if (CS%spongeDataOngrid) then - CS%Ref_val_v%id = init_external_field(filename_v, fieldname_v, domain=G%Domain%mpp_domain) + CS%Ref_val_v%field = init_external_field(filename_v, fieldname_v, domain=G%Domain%mpp_domain) else - CS%Ref_val_v%id = init_external_field(filename_v, fieldname_v) + CS%Ref_val_v%field = init_external_field(filename_v, fieldname_v) endif fld_sz(1:4) = -1 - call get_external_field_info(CS%Ref_val_v%id, size=fld_sz) + call get_external_field_info(CS%Ref_val_v%field, size=fld_sz) CS%Ref_val_v%nz_data = fld_sz(3) CS%Ref_val_v%num_tlevs = fld_sz(4) CS%Ref_val_v%scale = US%m_s_to_L_T ; if (present(scale)) CS%Ref_val_v%scale = scale @@ -989,7 +989,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data - call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, G, sp_val, & + call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%field, Time, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, & scale=CS%Ref_val(m)%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & answer_date=CS%hor_regrid_answer_date) @@ -1073,7 +1073,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, G, sp_val, & + call horiz_interp_and_extrap_tracer(CS%Ref_val_u%field, Time, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, & scale=CS%Ref_val_u%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & answer_date=CS%hor_regrid_answer_date) @@ -1121,7 +1121,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, G, sp_val, & + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%field, Time, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, & scale=CS%Ref_val_v%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answer_date=CS%hor_regrid_answer_date) @@ -1341,7 +1341,7 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) ! We don't want to repeat FMS init in set_up_ALE_sponge_field_varying() ! (time_interp_external_init, init_external_field, etc), so we manually ! do a portion of this function below. - sponge%Ref_val(n)%id = sponge_in%Ref_val(n)%id + sponge%Ref_val(n)%field = sponge_in%Ref_val(n)%field sponge%Ref_val(n)%num_tlevs = sponge_in%Ref_val(n)%num_tlevs nz_data = sponge_in%Ref_val(n)%nz_data diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ba8ba0b805..3096fe72cd 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -16,6 +16,7 @@ module MOM_diabatic_aux use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint use MOM_grid, only : ocean_grid_type use MOM_interpolate, only : init_external_field, time_interp_external, time_interp_external_init +use MOM_interpolate, only : external_field use MOM_io, only : slasher use MOM_opacity, only : set_opacity, opacity_CS, extract_optics_slice, extract_optics_fields use MOM_opacity, only : optics_type, optics_nbands, absorbRemainingSW, sumSWoverBands @@ -64,7 +65,7 @@ module MOM_diabatic_aux !! is added with a temperature of the local SST. logical :: var_pen_sw !< If true, use one of the CHL_A schemes to determine the !! e-folding depth of incoming shortwave radiation. - integer :: sbc_chl !< An integer handle used in time interpolation of + type(external_field) :: sbc_chl !< A handle used in time interpolation of !! chlorophyll read from a file. logical :: chl_from_file !< If true, chl_a is read from a file. @@ -827,7 +828,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) type(ocean_grid_type), intent(in) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(3), intent(in) :: Mixing_Energy !< Energy values for up to 3 MLDs [R Z L2 T-2 ~> J m-2] + real, dimension(3), intent(in) :: Mixing_Energy !< Energy values for up to 3 MLDs [R Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any @@ -884,7 +885,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) PE_Threshold_fraction = 1.e-4 !Fixed threshold of 0.01%, could be runtime. do iM=1,3 - PE_threshold(iM) = Mixing_Energy(iM)/GV%g_earth + PE_threshold(iM) = Mixing_Energy(iM) / (US%L_to_Z**2*GV%g_Earth) enddo do j=js,je ; do i=is,ie diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 44eed12295..1bc29ee16f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -43,7 +43,7 @@ module MOM_diabatic_driver use MOM_grid, only : ocean_grid_type use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type -use MOM_interface_heights, only : find_eta +use MOM_interface_heights, only : find_eta, calc_derived_thermo use MOM_internal_tides, only : propagate_int_tide use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used @@ -67,7 +67,6 @@ module MOM_diabatic_driver use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units -use MOM_wave_speed, only : wave_speeds, wave_speed_CS, wave_speed_init use MOM_wave_interface, only : wave_parameters_CS use MOM_stochastics, only : stochastic_CS @@ -123,9 +122,6 @@ module MOM_diabatic_driver !! shear and ePBL diffusivities are used. real :: ePBL_Prandtl !< The Prandtl number used by ePBL to convert vertical !! diffusivities into viscosities [nondim]. - integer :: nMode = 1 !< Number of baroclinic modes to consider - real :: uniform_test_cg !< Uniform group velocity of internal tide - !! for testing internal tides [L T-1 ~> m s-1] logical :: useALEalgorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical !! passed by argument to diabatic_driver_init. @@ -171,7 +167,7 @@ module MOM_diabatic_driver real :: MLDdensityDifference !< Density difference used to determine MLD_user [R ~> kg m-3] real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the !! average stratification at the base of the mixed layer [Z ~> m]. - real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics [R Z L2 T-2 ~> J m-2] + real :: MLD_En_vals(3) !< Energy values for energy mixed layer diagnostics [R Z3 T-2 ~> J m-2] !>@{ Diagnostic IDs integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed @@ -239,7 +235,6 @@ module MOM_diabatic_driver type(int_tide_CS) :: int_tide !< Internal tide control structure type(opacity_CS) :: opacity !< Opacity control structure type(regularize_layers_CS) :: regularize_layers !< Regularize layer control structure - type(wave_speed_CS) :: wave_speed !< Wave speed control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -297,8 +292,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & eta ! Interface heights before diapycnal mixing [Z ~> m] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn_IGW ! baroclinic internal gravity wave speeds [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: temp_diag ! Previous temperature for diagnostics [C ~> degC] real, dimension(SZI_(G)) :: T_freeze, & ! The freezing potential temperature at the current salinity [C ~> degC]. ps ! Surface pressure [R L2 T-2 ~> Pa] @@ -392,14 +385,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! This block provides an interface for the unresolved low-mode internal tide module. call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & CS%int_tide_input_CSp) - cn_IGW(:,:,:) = 0.0 - if (CS%uniform_test_cg > 0.0) then - do m=1,CS%nMode ; cn_IGW(:,:,m) = CS%uniform_test_cg ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, CS%wave_speed, full_halos=.true.) - endif - call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + call propagate_int_tide(h, tv, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide) if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -500,11 +487,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if ((CS%id_MLD_EN1 > 0) .or. (CS%id_MLD_EN2 > 0) .or. (CS%id_MLD_EN3 > 0)) then call diagnoseMLDbyEnergy((/CS%id_MLD_EN1, CS%id_MLD_EN2, CS%id_MLD_EN3/),& - h, tv, G, GV, US, CS%MLD_EN_VALS, CS%diag) - endif - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn_IGW(:,:,1),CS%diag) - do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m), cn_IGW(:,:,m), CS%diag) ; enddo + h, tv, G, GV, US, CS%MLD_En_vals, CS%diag) endif if (stoch_CS%do_sppt .and. stoch_CS%id_sppt_wts > 0) & @@ -712,6 +695,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! If visc%MLD exists, copy KPP's BLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif + if (associated(visc%sfc_buoy_flx)) then + visc%sfc_buoy_flx(:,:) = CS%KPP_buoy_flux(:,:,1) + call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) + endif if (.not.CS%KPPisPassive) then !$OMP parallel do default(shared) @@ -854,6 +841,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif + if (associated(visc%sfc_buoy_flx)) then + visc%sfc_buoy_flx(:,:) = SkinBuoyFlux(:,:) + call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) + endif ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie @@ -1306,6 +1297,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! If visc%MLD exists, copy KPP's BLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif + if (associated(visc%sfc_buoy_flx)) then + visc%sfc_buoy_flx(:,:) = CS%KPP_buoy_flux(:,:,1) + call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) + endif if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then @@ -1391,6 +1386,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif + if (associated(visc%sfc_buoy_flx)) then + visc%sfc_buoy_flx(:,:) = SkinBuoyFlux(:,:) + call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) + endif ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie @@ -1828,9 +1827,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Also changes: visc%Kd_shear and visc%Kv_shear if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) - if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) + if (associated(tv%S)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif + + ! Update derived thermodynamic quantities. + if ((CS%ML_mix_first > 0.0) .and. allocated(tv%SpV_avg)) then + call calc_derived_thermo(tv, h, G, GV, US, halo=CS%halo_TS_diff) + endif + if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then @@ -1900,6 +1905,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! If visc%MLD exists, copy KPP's BLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif + if (associated(visc%sfc_buoy_flx)) then + visc%sfc_buoy_flx(:,:) = CS%KPP_buoy_flux(:,:,1) + call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) + endif if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) @@ -2950,8 +2959,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Local variables real :: Kd ! A diffusivity used in the default for other tracer diffusivities [Z2 T-1 ~> m2 s-1] - real :: IGW_c1_thresh ! A threshold first mode internal wave speed below which all higher - ! mode speeds are not calculated but simply assigned a speed of 0 [L T-1 ~> m s-1]. logical :: use_temperature character(len=20) :: EN1, EN2, EN3 @@ -3044,23 +3051,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "INTERNAL_TIDES", CS%use_int_tides, & "If true, use the code that advances a separate set of "//& "equations for the internal tide energy density.", default=.false.) - CS%nMode = 1 - if (CS%use_int_tides) then - call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & - "The number of distinct internal tide modes "//& - "that will be calculated.", default=1, do_not_log=.true.) - call get_param(param_file, mdl, "INTERNAL_WAVE_CG1_THRESH", IGW_c1_thresh, & - "A minimal value of the first mode internal wave speed below which all higher "//& - "mode speeds are not calculated but are simply reported as 0. This must be "//& - "non-negative for the wave_speeds routine to be used.", & - units="m s-1", default=0.01, scale=US%m_s_to_L_T) - call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & - "If positive, a uniform group velocity of internal tide for test case", & - default=-1., units="m s-1", scale=US%m_s_to_L_T) - endif - - call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & - CS%massless_match_targets, & + + call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", CS%massless_match_targets, & "If true, the temperature and salinity of massless layers "//& "are kept consistent with their target densities. "//& "Otherwise the properties of massless layers evolve "//& @@ -3168,38 +3160,25 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) endif - if (CS%use_int_tides) then - CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & - Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s) - allocate(CS%id_cn(CS%nMode), source=-1) - do m=1,CS%nMode - write(var_name, '("cn_mode",i1)') m - write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m - CS%id_cn(m) = register_diag_field('ocean_model',var_name, diag%axesT1, & - Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) - call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - enddo - endif - if (use_temperature) then CS%id_Tdif = register_diag_field('ocean_model',"Tflx_dia_diff", diag%axesTi, & Time, "Diffusive diapycnal temperature flux across interfaces", & - "degC m s-1", conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) + units="degC m s-1", conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) if (.not.CS%useALEalgorithm) then CS%id_Tadv = register_diag_field('ocean_model',"Tflx_dia_adv", diag%axesTi, & Time, "Advective diapycnal temperature flux across interfaces", & - "degC m s-1", conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) + units="degC m s-1", conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) endif CS%id_Sdif = register_diag_field('ocean_model',"Sflx_dia_diff", diag%axesTi, & Time, "Diffusive diapycnal salnity flux across interfaces", & - "psu m s-1", conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) + units="psu m s-1", conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) if (.not.CS%useALEalgorithm) then CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv", diag%axesTi, & Time, "Advective diapycnal salnity flux across interfaces", & - "psu m s-1", conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) + units="psu m s-1", conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) endif CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & - 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=US%Z_to_m, & + 'Mixed layer depth (delta rho = 0.03)', units='m', conversion=US%Z_to_m, & cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') CS%id_mlotstsq = register_diag_field('ocean_model', 'mlotstsq', diag%axesT1, Time, & @@ -3208,31 +3187,31 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di units='m2', conversion=US%Z_to_m**2) CS%id_MLD_0125 = register_diag_field('ocean_model', 'MLD_0125', diag%axesT1, Time, & 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) - call get_param(param_file, mdl, "MLD_EN_VALS", CS%MLD_EN_VALS, & + call get_param(param_file, mdl, "MLD_EN_VALS", CS%MLD_En_vals, & "The energy values used to compute MLDs. If not set (or all set to 0.), the "//& - "default will overwrite to 25., 2500., 250000.",units='J/m2', default=0., & - scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**2) - if ((CS%MLD_EN_VALS(1)==0.).and.(CS%MLD_EN_VALS(2)==0.).and.(CS%MLD_EN_VALS(3)==0.)) then - CS%MLD_EN_VALS = (/25.*US%kg_m3_to_R*US%m_to_Z*US%m_to_L**2*US%T_to_s**2,& - 2500.*US%kg_m3_to_R*US%m_to_Z*US%m_to_L**2*US%T_to_s**2,& - 250000.*US%kg_m3_to_R*US%m_to_Z*US%m_to_L**2*US%T_to_s**2/) - endif - write(EN1,'(F10.2)') CS%MLD_EN_VALS(1)*US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**2 - write(EN2,'(F10.2)') CS%MLD_EN_VALS(2)*US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**2 - write(EN3,'(F10.2)') CS%MLD_EN_VALS(3)*US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**2 + "default will overwrite to 25., 2500., 250000.", & + units='J/m2', default=0., scale=US%W_m2_to_RZ3_T3*US%s_to_T) + if ((CS%MLD_En_vals(1)==0.).and.(CS%MLD_En_vals(2)==0.).and.(CS%MLD_En_vals(3)==0.)) then + CS%MLD_En_vals = (/ 25.*US%W_m2_to_RZ3_T3*US%s_to_T, & + 2500.*US%W_m2_to_RZ3_T3*US%s_to_T, & + 250000.*US%W_m2_to_RZ3_T3*US%s_to_T /) + endif + write(EN1,'(F10.2)') CS%MLD_En_vals(1)*US%RZ3_T3_to_W_m2*US%T_to_s + write(EN2,'(F10.2)') CS%MLD_En_vals(2)*US%RZ3_T3_to_W_m2*US%T_to_s + write(EN3,'(F10.2)') CS%MLD_En_vals(3)*US%RZ3_T3_to_W_m2*US%T_to_s CS%id_MLD_EN1 = register_diag_field('ocean_model', 'MLD_EN1', diag%axesT1, Time, & 'Mixed layer depth for energy value set to '//trim(EN1)//' J/m2 (Energy set by 1st MLD_EN_VALS)', & - 'm', conversion=US%Z_to_m) + units='m', conversion=US%Z_to_m) CS%id_MLD_EN2 = register_diag_field('ocean_model', 'MLD_EN2', diag%axesT1, Time, & 'Mixed layer depth for energy value set to '//trim(EN2)//' J/m2 (Energy set by 2nd MLD_EN_VALS)', & - 'm', conversion=US%Z_to_m) + units='m', conversion=US%Z_to_m) CS%id_MLD_EN3 = register_diag_field('ocean_model', 'MLD_EN3', diag%axesT1, Time, & 'Mixed layer depth for energy value set to '//trim(EN3)//' J/m2 (Energy set by 3rd MLD_EN_VALS)', & - 'm', conversion=US%Z_to_m) + units='m', conversion=US%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model', 'subML_N2', diag%axesT1, Time, & - 'Squared buoyancy frequency below mixed layer', 's-2', conversion=US%s_to_T**2) + 'Squared buoyancy frequency below mixed layer', units='s-2', conversion=US%s_to_T**2) CS%id_MLD_user = register_diag_field('ocean_model', 'MLD_user', diag%axesT1, Time, & - 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) + 'Mixed layer depth (used defined)', units='m', conversion=US%Z_to_m) endif call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed "//& @@ -3475,7 +3454,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) - call wave_speed_init(CS%wave_speed, c1_thresh=IGW_c1_thresh) endif physical_OBL_scheme = (CS%use_bulkmixedlayer .or. CS%use_KPP .or. CS%use_energetic_PBL) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1e3bf258d8..47d4dffef6 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1870,7 +1870,7 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL - logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv + logical :: use_CVMix_shear, MLE_use_PBL_MLD, MLE_use_Bodner, use_CVMix_conv integer :: isd, ied, jsd, jed, nz real :: hfreeze !< If hfreeze > 0 [Z ~> m], melt potential will be computed. character(len=40) :: mdl = "MOM_set_visc" ! This module's name. @@ -1942,6 +1942,15 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) endif + ! visc%sfc_buoy_flx is used to communicate the state of the (e)PBL or KPP to the rest of the model + call get_param(param_file, mdl, "MLE%USE_BODNER23", MLE_use_Bodner, & + default=.false., do_not_log=.true.) + if (MLE_use_PBL_MLD .or. MLE_use_Bodner) then + call safe_alloc_ptr(visc%sfc_buoy_flx, isd, ied, jsd, jed) + call register_restart_field(visc%sfc_buoy_flx, "SFC_BFLX", .false., restart_CS, & + "Instantaneous surface buoyancy flux", "m2 s-3", & + conversion=US%Z_to_m**2*US%s_to_T**3) + endif end subroutine set_visc_register_restarts @@ -2003,12 +2012,6 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS real :: Hbbl ! The static bottom boundary layer thickness [Z ~> m]. real :: BBL_thick_min ! The minimum bottom boundary layer thickness [Z ~> m]. - real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a restart file to the internal representation in this run [nondim]? - real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run - ! to the representation in a restart file [nondim]? - real :: Z2_T_rescale ! A rescaling factor for vertical diffusivities and viscosities from the - ! representation in a restart file to the internal representation in this run [nondim]? integer :: i, j, k, is, ie, js, je integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. @@ -2317,42 +2320,6 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) - ! Account for possible changes in dimensional scaling for variables that have been - ! read from a restart file. - Z_rescale = 1.0 - if (US%m_to_Z_restart /= 0.0) Z_rescale = 1.0 / US%m_to_Z_restart - I_T_rescale = 1.0 - if (US%s_to_T_restart /= 0.0) I_T_rescale = US%s_to_T_restart - Z2_T_rescale = Z_rescale**2*I_T_rescale - - if (Z2_T_rescale /= 1.0) then - if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_shear(i,j,k) = Z2_T_rescale * visc%Kd_shear(i,j,k) - enddo ; enddo ; enddo - endif ; endif - - if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = Z2_T_rescale * visc%Kv_shear(i,j,k) - enddo ; enddo ; enddo - endif ; endif - - if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then - do k=1,nz+1 ; do J=js-1,je ; do I=is-1,ie - visc%Kv_shear_Bu(I,J,k) = Z2_T_rescale * visc%Kv_shear_Bu(I,J,k) - enddo ; enddo ; enddo - endif ; endif - endif - - if (MLE_use_PBL_MLD .and. (Z_rescale /= 1.0)) then - if (associated(visc%MLD)) then ; if (query_initialized(visc%MLD, "MLD", restart_CS)) then - do j=js,je ; do i=is,ie - visc%MLD(i,j) = Z_rescale * visc%MLD(i,j) - enddo ; enddo - endif ; endif - endif - end subroutine set_visc_init !> This subroutine dellocates any memory in the set_visc control structure. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ea6c7f112b..80fff62f21 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -139,8 +139,11 @@ module MOM_vert_friction integer :: answer_date !< The vintage of the order of arithmetic and expressions in the viscous !! calculations. Values below 20190101 recover the answers from the end !! of 2018, while higher values use expressions that do not use an - !! arbitrary and hard-coded maximum viscous coupling coefficient - !! between layers. + !! arbitrary and hard-coded maximum viscous coupling coefficient between + !! layers. In non-Boussinesq cases, values below 20230601 recover a + !! form of the viscosity within the mixed layer that breaks up the + !! magnitude of the wind stress with BULKMIXEDLAYER, DYNAMIC_VISCOUS_ML + !! or FIXED_DEPTH_LOTW_ML, but not LOTW_VISCOUS_ML_FLOOR. logical :: debug !< If true, write verbose checksums for debugging purposes. integer :: nkml !< The number of layers in the mixed layer. integer, pointer :: ntrunc !< The number of times the velocity has been @@ -1516,6 +1519,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G)) :: & u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]. + tau_mag, & ! The magnitude of the wind stress at a velocity point including gustiness, + ! divided by the Boussinesq refernce density [Z2 T-2 ~> m2 s-2] absf, & ! The average of the neighboring absolute values of f [T-1 ~> s-1]. ! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. z_t, & ! The distance from the top, sometimes normalized @@ -1888,7 +1893,12 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) ! and be further limited by rotation to give the natural Ekman length. - visc_ml = u_star(i) * CS%vonKar * (temp1*u_star(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + if (GV%Boussinesq .or. (CS%answer_date < 20230601)) then + visc_ml = u_star(i) * CS%vonKar * (temp1*u_star(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + else + tau_mag(i) = u_star(i)**2 + visc_ml = CS%vonKar * (temp1*tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + endif a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml) ! Choose the largest estimate of a_cpl, but these could be changed to be additive. @@ -2180,7 +2190,9 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The vintage of the order of arithmetic and expressions in the viscous "//& "calculations. Values below 20190101 recover the answers from the end of 2018, "//& "while higher values use expressions that do not use an arbitrary hard-coded "//& - "maximum viscous coupling coefficient between layers. "//& + "maximum viscous coupling coefficient between layers. Values below 20230601 "//& + "recover a form of the viscosity within the mixed layer that breaks up the "//& + "magnitude of the wind stress in some non-Boussinesq cases. "//& "If both VERT_FRICTION_2018_ANSWERS and VERT_FRICTION_ANSWER_DATE are "//& "specified, the latter takes precedence.", default=default_answer_date) diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 4364dac0fd..41a9cba8f4 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -1,4 +1,4 @@ -!> Simulates CFCs using atmospheric pressure, wind speed and sea ice cover + !> Simulates CFCs using atmospheric pressure, wind speed and sea ice cover !! provided via cap (only NUOPC cap is implemented so far). module MOM_CFC_cap @@ -20,7 +20,7 @@ module MOM_CFC_cap use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS use MOM_spatial_means, only : global_mass_int_EFP use MOM_time_manager, only : time_type, increment_date -use time_interp_external_mod, only : init_external_field, time_interp_external +use MOM_interpolate, only : external_field, init_external_field, time_interp_external use MOM_tracer_registry, only : register_tracer use MOM_tracer_types, only : tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut @@ -70,10 +70,10 @@ module MOM_CFC_cap type(CFC_tracer_data), dimension(NTR) :: CFC_data !< per-tracer parameters / metadata integer :: CFC_BC_year_offset = 0 !< offset to add to model time to get time value used in CFC_BC_file - integer :: id_cfc11_atm_nh = -1 !< id number for time_interp_external. - integer :: id_cfc11_atm_sh = -1 !< id number for time_interp_external. - integer :: id_cfc12_atm_nh = -1 !< id number for time_interp_external. - integer :: id_cfc12_atm_sh = -1 !< id number for time_interp_external. + type(external_field) :: cfc11_atm_nh_handle !< Handle for time-interpolated CFC11 atm NH + type(external_field) :: cfc11_atm_sh_handle !< Handle for time-interpolated CFC11 atm SH + type(external_field) :: cfc12_atm_nh_handle !< Handle for time-interpolated CFC12 atm NH + type(external_field) :: cfc12_atm_sh_handle !< Handle for time-interpolated CFC12 atm SH end type CFC_cap_CS contains @@ -168,22 +168,23 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "CFC11_NH_VARIABLE", CFC_BC_var_name, & "Variable name of NH CFC-11 atm mole fraction in CFC_BC_FILE.", & default="cfc11_nh") - CS%id_cfc11_atm_nh = init_external_field(CFC_BC_file, CFC_BC_var_name) + CS%cfc11_atm_nh_handle = init_external_field(CFC_BC_file, CFC_BC_var_name) call get_param(param_file, mdl, "CFC11_SH_VARIABLE", CFC_BC_var_name, & "Variable name of SH CFC-11 atm mole fraction in CFC_BC_FILE.", & default="cfc11_sh") - CS%id_cfc11_atm_sh = init_external_field(CFC_BC_file, CFC_BC_var_name) + CS%cfc11_atm_sh_handle = init_external_field(CFC_BC_file, CFC_BC_var_name) call get_param(param_file, mdl, "CFC12_NH_VARIABLE", CFC_BC_var_name, & "Variable name of NH CFC-12 atm mole fraction in CFC_BC_FILE.", & default="cfc12_nh") - CS%id_cfc12_atm_nh = init_external_field(CFC_BC_file, CFC_BC_var_name) + CS%cfc12_atm_nh_handle = init_external_field(CFC_BC_file, CFC_BC_var_name) call get_param(param_file, mdl, "CFC12_SH_VARIABLE", CFC_BC_var_name, & "Variable name of SH CFC-12 atm mole fraction in CFC_BC_FILE.", & default="cfc12_sh") - CS%id_cfc12_atm_sh = init_external_field(CFC_BC_file, CFC_BC_var_name) + CS%cfc12_atm_sh_handle = init_external_field(CFC_BC_file, CFC_BC_var_name) +! domain=G%Domain%mpp_domain) ! The following vardesc types contain a package of metadata about each tracer, ! including, the name; units; longname; and grid information. @@ -502,15 +503,15 @@ subroutine CFC_cap_set_forcing(sfc_state, fluxes, day_start, day_interval, G, US Time_external = increment_date(day_start, years=CS%CFC_BC_year_offset) ! CFC11 atm mole fraction, convert from ppt (pico mol/mol) to mol/mol - call time_interp_external(CS%id_cfc11_atm_nh, Time_external, cfc11_atm_nh) + call time_interp_external(CS%cfc11_atm_nh_handle, Time_external, cfc11_atm_nh) cfc11_atm_nh = cfc11_atm_nh * 1.0e-12 - call time_interp_external(CS%id_cfc11_atm_sh, Time_external, cfc11_atm_sh) + call time_interp_external(CS%cfc11_atm_sh_handle, Time_external, cfc11_atm_sh) cfc11_atm_sh = cfc11_atm_sh * 1.0e-12 ! CFC12 atm mole fraction, convert from ppt (pico mol/mol) to mol/mol - call time_interp_external(CS%id_cfc12_atm_nh, Time_external, cfc12_atm_nh) + call time_interp_external(CS%cfc12_atm_nh_handle, Time_external, cfc12_atm_nh) cfc12_atm_nh = cfc12_atm_nh * 1.0e-12 - call time_interp_external(CS%id_cfc12_atm_sh, Time_external, cfc12_atm_sh) + call time_interp_external(CS%cfc12_atm_sh_handle, Time_external, cfc12_atm_sh) cfc12_atm_sh = cfc12_atm_sh * 1.0e-12 !--------------------------------------------------------------------- diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index cdabfa1277..c49c6a9a23 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -167,7 +167,7 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, call get_param(param_file, mdl, "NDIFF_REF_PRES", CS%ref_pres, & "The reference pressure (Pa) used for the derivatives of "//& "the equation of state. If negative (default), local pressure is used.", & - units="Pa", default=-1., scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=-1., scale=US%Pa_to_RL2_T2) call get_param(param_file, mdl, "NDIFF_INTERIOR_ONLY", CS%interior_only, & "If true, only applies neutral diffusion in the ocean interior."//& "That is, the algorithm will exclude the surface and bottom"//& diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 2200a28c2b..40dced9b20 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -22,6 +22,7 @@ module MOM_offline_main use MOM_file_parser, only : read_param, get_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : calc_derived_thermo use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER use MOM_offline_aux, only : update_offline_from_arrays, update_offline_from_files use MOM_offline_aux, only : next_modulo_time, offline_add_diurnal_sw @@ -304,7 +305,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_m) + call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_MKS) call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) endif tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) @@ -345,7 +346,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C ! Do ALE remapping/regridding to allow for more advection to occur in the next iteration call pass_var(h_new,G%Domain) if (CS%debug) then - call hchksum(h_new,"h_new before ALE", G%HI, scale=GV%H_to_m) + call hchksum(h_new,"h_new before ALE", G%HI, scale=GV%H_to_MKS) write(debug_msg, '(A,I4.4)') 'Before ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg) endif @@ -370,7 +371,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C call cpu_clock_end(id_clock_ALE) if (CS%debug) then - call hchksum(h_new, "h_new after ALE", G%HI, scale=GV%H_to_m) + call hchksum(h_new, "h_new after ALE", G%HI, scale=GV%H_to_MKS) write(debug_msg, '(A,I4.4)') 'After ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg) endif @@ -412,7 +413,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then - call hchksum(h_pre, "h after offline_advection_ale", G%HI, scale=GV%H_to_m) + call hchksum(h_pre, "h after offline_advection_ale", G%HI, scale=GV%H_to_MKS) call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg) endif @@ -599,7 +600,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve if (CS%id_vhr>0) call post_data(CS%id_vhr, vhtr, CS%diag) if (CS%debug) then - call hchksum(h_pre, "h_pre after redistribute", G%HI, scale=GV%H_to_m) + call hchksum(h_pre, "h_pre after redistribute", G%HI, scale=GV%H_to_MKS) call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg) endif @@ -679,9 +680,9 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p call MOM_mesg("Applying tracer source, sinks, and vertical mixing") if (CS%debug) then - call hchksum(h_pre, "h_pre before offline_diabatic_ale", G%HI, scale=GV%H_to_m) - call hchksum(eatr, "eatr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) - call hchksum(ebtr, "ebtr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(h_pre, "h_pre before offline_diabatic_ale", G%HI, scale=GV%H_to_MKS) + call hchksum(eatr, "eatr before offline_diabatic_ale", G%HI, scale=GV%H_to_MKS) + call hchksum(ebtr, "ebtr before offline_diabatic_ale", G%HI, scale=GV%H_to_MKS) call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg) endif @@ -743,9 +744,9 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p endif if (CS%debug) then - call hchksum(h_pre, "h_pre after offline_diabatic_ale", G%HI, scale=GV%H_to_m) - call hchksum(eatr, "eatr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) - call hchksum(ebtr, "ebtr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(h_pre, "h_pre after offline_diabatic_ale", G%HI, scale=GV%H_to_MKS) + call hchksum(eatr, "eatr after offline_diabatic_ale", G%HI, scale=GV%H_to_MKS) + call hchksum(ebtr, "ebtr after offline_diabatic_ale", G%HI, scale=GV%H_to_MKS) call MOM_tracer_chkinv("After offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg) endif @@ -786,7 +787,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) enddo ; enddo if (CS%debug) then - call hchksum(h, "h before fluxes into ocean", G%HI, scale=GV%H_to_m) + call hchksum(h, "h before fluxes into ocean", G%HI, scale=GV%H_to_MKS) call MOM_tracer_chkinv("Before fluxes into ocean", G, GV, h, CS%tracer_reg) endif do m = 1,CS%tracer_reg%ntr @@ -796,7 +797,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt=update_h) enddo if (CS%debug) then - call hchksum(h, "h after fluxes into ocean", G%HI, scale=GV%H_to_m) + call hchksum(h, "h after fluxes into ocean", G%HI, scale=GV%H_to_MKS) call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg) endif @@ -825,7 +826,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) call MOM_error(WARNING, "Negative freshwater fluxes with non-zero tracer concentration not supported yet") if (CS%debug) then - call hchksum(h, "h before fluxes out of ocean", G%HI, scale=GV%H_to_m) + call hchksum(h, "h before fluxes out of ocean", G%HI, scale=GV%H_to_MKS) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg) endif do m = 1, CS%tracer_reg%ntr @@ -835,7 +836,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) enddo if (CS%debug) then - call hchksum(h, "h after fluxes out of ocean", G%HI, scale=GV%H_to_m) + call hchksum(h, "h after fluxes out of ocean", G%HI, scale=GV%H_to_MKS) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg) endif @@ -1025,6 +1026,7 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields logical, intent(in ) :: do_ale !< True if using ALE ! Local variables + integer :: stencil integer :: i, j, k, is, ie, js, je, nz real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_start ! Initial thicknesses [H ~> m or kg m-2] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1035,7 +1037,7 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) if (CS%debug) then call uvchksum("[uv]htr before update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & scale=US%L_to_m**2*GV%H_to_kg_m2) - call hchksum(CS%h_end, "h_end before update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%h_end, "h_end before update_offline_fields", G%HI, scale=GV%H_to_MKS) call hchksum(CS%tv%T, "Temp before update_offline_fields", G%HI, scale=US%C_to_degC) call hchksum(CS%tv%S, "Salt before update_offline_fields", G%HI, scale=US%S_to_ppt) endif @@ -1077,7 +1079,7 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) if (CS%debug) then call uvchksum("[uv]htr after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, G%HI, & scale=US%L_to_m**2*GV%H_to_kg_m2) - call hchksum(h_start,"h_start after ALE regridding/remapping of inputs", G%HI, scale=GV%H_to_m) + call hchksum(h_start,"h_start after ALE regridding/remapping of inputs", G%HI, scale=GV%H_to_MKS) endif endif @@ -1086,6 +1088,12 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) call pass_var(CS%tv%T, G%Domain) call pass_var(CS%tv%S, G%Domain) + ! Update derived thermodynamic quantities. + if (allocated(CS%tv%SpV_avg)) then + stencil = min(3, G%Domain%nihalo, G%Domain%njhalo) + call calc_derived_thermo(CS%tv, CS%h_end, G, GV, US, halo=stencil) + endif + ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) CS%ridx_sum = next_modulo_time(CS%ridx_sum,CS%numtime) @@ -1119,7 +1127,7 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) if (CS%debug) then call uvchksum("[uv]htr after update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & scale=US%L_to_m**2*GV%H_to_kg_m2) - call hchksum(CS%h_end, "h_end after update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%h_end, "h_end after update_offline_fields", G%HI, scale=GV%H_to_MKS) call hchksum(CS%tv%T, "Temp after update_offline_fields", G%HI, scale=US%C_to_degC) call hchksum(CS%tv%S, "Salt after update_offline_fields", G%HI, scale=US%S_to_ppt) endif diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index c089181c16..fab7da3917 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -556,8 +556,8 @@ end function find_limited_slope !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess -subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_start, G, GV, US, & - PF, just_read, h_massless) +subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, k_start, G, GV, US, PF, & + just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -565,20 +565,15 @@ subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_star real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: salt !< salinity [S ~> ppt] real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. - type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure + type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< layer thickness, used only to avoid working on - !! massless layers [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T or S. - real, optional, intent(in) :: h_massless !< A threshold below which a layer is - !! determined to be massless [H ~> m or kg m-2] ! Local variables (All of which need documentation!) real, dimension(SZI_(G),SZK_(GV)) :: & @@ -587,7 +582,6 @@ subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_star dT, & ! An estimated change in temperature before bounding [C ~> degC] dS, & ! An estimated change in salinity before bounding [S ~> ppt] rho, & ! Layer densities with the current estimate of temperature and salinity [R ~> kg m-3] - hin, & ! A 2D copy of the layer thicknesses [H ~> m or kg m-2] drho_dT, & ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] drho_dS ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G)) :: press ! Reference pressures [R L2 T-2 ~> Pa] @@ -675,7 +669,6 @@ subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_star dS(:,:) = 0. ! Needs to be zero everywhere since there is a maxval(abs(dS)) later... T(:,:) = temp(:,j,:) S(:,:) = salt(:,j,:) - hin(:,:) = h(:,j,:) dT(:,:) = 0.0 adjust_salt = .true. iter_loop: do itt = 1,niter @@ -685,7 +678,7 @@ subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_star EOS, EOSdom ) enddo do k=k_start,nz ; do i=is,ie -! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln) then +! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. abs(T(i,k)-land_fill) < epsln) then if (abs(rho(i,k)-R_tgt(k))>tol_rho) then if (.not.fit_together) then dT(i,k) = max(min((R_tgt(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) @@ -713,7 +706,7 @@ subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_star EOS, EOSdom ) enddo do k=k_start,nz ; do i=is,ie -! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln ) then +! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. abs(T(i,k)-land_fill) < epsln ) then if (abs(rho(i,k)-R_tgt(k)) > tol_rho) then dS(i,k) = max(min((R_tgt(k)-rho(i,k)) / drho_dS(i,k), max_s_adj), -max_s_adj) S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 2a3727bdca..17c1f30525 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -189,10 +189,6 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, endif enddo ! Tracer loop - if (restart .and. (US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= 1.0) ) then - CS%remaining_source_time = (1.0 / US%s_to_T_restart) * CS%remaining_source_time - endif - if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. endif diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 1382fe8e34..dade17a9a0 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -9,6 +9,7 @@ module DOME2d_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : dz_to_thickness, dz_to_thickness_simple use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs @@ -98,7 +99,7 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -158,16 +159,16 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom_H - h(i,j,nz) = GV%Z_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H + h(i,j,1:nz-1) = GV%Angstrom_Z + h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_Z endif enddo ; enddo @@ -180,16 +181,16 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then ! eta1D(k) = eta1D(k+1) + min_thickness - ! h(i,j,k) = GV%Z_to_H * min_thickness + ! h(i,j,k) = min_thickness ! else - ! h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + ! h(i,j,k) = eta1D(k) - eta1D(k+1) ! endif ! enddo ! ! x = G%geoLonT(i,j) / G%len_lon ! if ( x <= dome2d_width_bay ) then - ! h(i,j,1:nz-1) = GV%Z_to_H * min_thickness - ! h(i,j,nz) = GV%Z_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) + ! h(i,j,1:nz-1) = min_thickness + ! h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness ! endif ! ! enddo ; enddo @@ -202,16 +203,16 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%Z_to_H * min_thickness + h(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H*depth_tot(i,j) / nz + h(i,j,:) = depth_tot(i,j) / nz enddo ; enddo case default @@ -225,11 +226,11 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, just_read) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: just_read !< If true, this call will @@ -287,7 +288,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth + xi1 = xi0 + h(i,j,k) / G%max_depth S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -298,7 +299,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth + xi1 = xi0 + h(i,j,k) / G%max_depth S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -373,7 +374,8 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [C ~> degC] real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [S ~> ppt] - real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2]. + real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness in height units [Z ~> m] + real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2] real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] @@ -478,30 +480,38 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + dz(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + dz(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo - ! Store the grid on which the T/S sponge data will reside - call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 do j=js,je ; do i=is,ie z = -depth_tot(i,j) do k = nz,1,-1 - z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k + z = z + 0.5 * dz(i,j,k) ! Position of the center of layer k ! Use salinity stratification in the eastern sponge. S(i,j,k) = S_surf - S_range_sponge * (z / G%max_depth) ! Use a constant salinity in the western sponge. if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range - z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k + z = z + 0.5 * dz(i,j,k) ! Position of the interface k enddo enddo ; enddo + ! Convert thicknesses from height units to thickness units + if (associated(tv%eqn_of_state)) then + call dz_to_thickness(dz, T, S, tv%eqn_of_state, h, G, GV, US) + else + call dz_to_thickness_simple(dz, h, G, GV, US, layer_mode=.true.) + endif + + ! Store damping rates and the grid on which the T/S sponge data will reside + call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp, 'temp', & sp_long_name='temperature', sp_unit='degC s-1') if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 7f939ffef6..4a12387d9d 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -105,7 +105,7 @@ subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -141,9 +141,9 @@ subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) endif enddo enddo ; enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index bba357f490..232ce6d4e7 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -10,6 +10,7 @@ module ISOMIP_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : dz_to_thickness use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs @@ -143,11 +144,10 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. + type(param_file_type), intent(in) :: param_file !< A structure to parse for model parameter values type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields, including !! the eqn. of state. @@ -170,7 +170,7 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.just_read) & - call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + call MOM_mesg("ISOMIP_initialization.F90, ISOMIP_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=US%m_to_Z) @@ -225,9 +225,9 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -240,9 +240,9 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%Z_to_H * min_thickness + h(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -250,7 +250,7 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * depth_tot(i,j) / real(nz) + h(i,j,:) = depth_tot(i,j) / real(nz) enddo ; enddo case default @@ -269,7 +269,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The nominal total bottom-to-top !! depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure @@ -334,10 +334,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U do j=js,je ; do i=is,ie xi0 = -depth_tot(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer + xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 T(i,j,k) = T_sur + dT_dz * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) ! Depth at top of layer enddo enddo ; enddo @@ -372,10 +372,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U xi0 = 0.0 do k = 1,nz !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z + xi1 = xi0 + 0.5 * h(i,j,k) S0(k) = S_sur - dS_dz * xi1 T0(k) = T_sur - dT_dz * xi1 - xi0 = xi0 + h(i,j,k) * GV%H_to_Z + xi0 = xi0 + h(i,j,k) ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k ! call MOM_mesg(mesg,5) enddo @@ -430,7 +430,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U !i=G%iec; j=G%jec !do k = 1,nz ! call calculate_density(T(i,j,k), S(i,j,k),0.0,rho_tmp,eqn_of_state, scale=US%kg_m3_to_R) - ! write(mesg,*) 'k,h,T,S,rho,Rlay',k,h(i,j,k),US%C_to_degC*T(i,j,k),US%S_to_ppt*S(i,j,k),rho_tmp,GV%Rlay(k) + ! write(mesg,*) 'k,h,T,S,rho,Rlay',k,US%Z_to_m*h(i,j,k),US%C_to_degC*T(i,j,k),US%S_to_ppt*S(i,j,k),rho_tmp,GV%Rlay(k) ! call MOM_mesg(mesg,5) !enddo @@ -440,27 +440,25 @@ end subroutine ISOMIP_initialize_temperature_salinity ! the values towards which the interface heights and an arbitrary ! number of tracers should be restored within each sponge. subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ACSp) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers - !! to any available thermodynamic - !! fields, potential temperature and - !! salinity or mixed layer density. - !! Absent fields have NULL ptrs. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available + !! thermodynamic fields, potential temperature and + !! salinity or mixed layer density. + !! Absent fields have NULL ptrs. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: PF !< A structure indicating the - !! open file to parse for model - !! parameter values. - logical, intent(in) :: use_ALE !< If true, indicates model is in ALE mode - type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure - type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: PF !< A structure to parse for model parameter values + logical, intent(in) :: use_ALE !< If true, indicates model is in ALE mode + type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure + type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [C ~> degC] real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [S ~> ppt] ! real :: RHO(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for RHO [R ~> kg m-3] - real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2] + real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! Sponge layer thicknesses in height units [Z ~> m] + real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! Sponge layer thicknesses [H ~> m or kg m-2] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: TNUDG ! Nudging time scale [T ~> s] real :: S_sur, S_bot ! Surface and bottom salinities in the sponge region [S ~> ppt] @@ -582,9 +580,9 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + dz(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) + dz(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -596,16 +594,16 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness * GV%Z_to_H + dz(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) + dz(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * (depth_tot(i,j) / real(nz)) + dz(i,j,:) = depth_tot(i,j) / real(nz) enddo ; enddo case default @@ -614,21 +612,25 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, end select - ! This call sets up the damping rates and interface heights. - ! This sets the inverse damping timescale fields in the sponges. - call initialize_ALE_sponge(Idamp, G, GV, PF, ACSp, h, nz) - dS_dz = (S_sur - S_bot) / G%max_depth dT_dz = (T_sur - T_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -depth_tot(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer + xi0 = xi0 + 0.5 * dz(i,j,k) ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 T(i,j,k) = T_sur + dT_dz * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer + xi0 = xi0 + 0.5 * dz(i,j,k) ! Depth at top of layer enddo enddo ; enddo + + ! Convert thicknesses from height units to thickness units + if (associated(tv%eqn_of_state)) then + call dz_to_thickness(dz, T, S, tv%eqn_of_state, h, G, GV, US) + else + call MOM_error(FATAL, "The ISOMIP test case requires an equation of state.") + endif + ! for debugging !i=G%iec; j=G%jec !do k = 1,nz @@ -637,6 +639,9 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! call MOM_mesg(mesg,5) !enddo + ! This call sets up the damping rates and interface heights in the sponges. + call initialize_ALE_sponge(Idamp, G, GV, PF, ACSp, h, nz) + ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! ! momentum is typically not damped within the sponge. ! diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 0d2926798f..ad930911ca 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -102,7 +102,7 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) ! Local variables real :: dP ! The pressure difference across the hurricane [R L2 T-2 ~> Pa] - real :: C + real :: C ! A temporary variable [nondim] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 ! If true, use expressions driving the idealized hurricane test @@ -132,10 +132,10 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) units='kg/m3', default=1.2, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "IDL_HURR_AMBIENT_PRESSURE", CS%pressure_ambient, & "Ambient pressure used in the idealized hurricane wind profile.", & - units='Pa', default=101200., scale=US%m_s_to_L_T**2*US%kg_m3_to_R) + units='Pa', default=101200., scale=US%Pa_to_RL2_T2) call get_param(param_file, mdl, "IDL_HURR_CENTRAL_PRESSURE", CS%pressure_central, & "Central pressure used in the idealized hurricane wind profile.", & - units='Pa', default=96800., scale=US%m_s_to_L_T**2*US%kg_m3_to_R) + units='Pa', default=96800., scale=US%Pa_to_RL2_T2) call get_param(param_file, mdl, "IDL_HURR_RAD_MAX_WIND", & CS%rad_max_wind, "Radius of maximum winds used in the "//& "idealized hurricane wind profile.", & diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index d218b4ea80..363a41f72f 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -525,8 +525,6 @@ subroutine controlled_forcing_init(Time, G, US, param_file, diag, CS) ! Local variables real :: smooth_len ! A smoothing lengthscale [L ~> m] - real :: RZ_T_rescale ! Unit conversion factor for precipiation [T kg m-2 s-1 R-1 Z-1 ~> 1] - real :: QRZ_T_rescale ! Unit conversion factor for head fluxes [T W m-2 Q-1 R-1 Z-1 ~> 1] logical :: do_integrated integer :: num_cycle integer :: i, j, isc, iec, jsc, jec, m @@ -601,53 +599,6 @@ subroutine controlled_forcing_init(Time, G, US, param_file, diag, CS) 'Control Corrective Precipitation', 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) endif - ! Rescale if there are differences between the dimensional scaling of variables in - ! restart files from those in use for this run. - if ((US%J_kg_to_Q_restart*US%kg_m3_to_R_restart*US%m_to_Z_restart*US%s_to_T_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%J_kg_to_Q_restart * US%kg_m3_to_R_restart * US%m_to_Z_restart) ) then - ! Redo the scaling of the corrective heat fluxes to [Q R Z T-1 ~> W m-2] - QRZ_T_rescale = US%s_to_T_restart / (US%J_kg_to_Q_restart * US%kg_m3_to_R_restart * US%m_to_Z_restart) - - if (associated(CS%heat_0)) then - do j=jsc,jec ; do i=isc,iec - CS%heat_0(i,j) = QRZ_T_rescale * CS%heat_0(i,j) - enddo ; enddo - endif - - if ((CS%num_cycle > 0) .and. associated(CS%heat_cyc)) then - do m=1,CS%num_cycle ; do j=jsc,jec ; do i=isc,iec - CS%heat_cyc(i,j,m) = QRZ_T_rescale * CS%heat_cyc(i,j,m) - enddo ; enddo ; enddo - endif - endif - - if ((US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%kg_m3_to_R_restart * US%m_to_Z_restart) ) then - ! Redo the scaling of the corrective precipitation to [R Z T-1 ~> kg m-2 s-1] - RZ_T_rescale = US%s_to_T_restart / (US%kg_m3_to_R_restart * US%m_to_Z_restart) - - if (associated(CS%precip_0)) then - do j=jsc,jec ; do i=isc,iec - CS%precip_0(i,j) = RZ_T_rescale * CS%precip_0(i,j) - enddo ; enddo - endif - - if ((CS%num_cycle > 0) .and. associated(CS%precip_cyc)) then - do m=1,CS%num_cycle ; do j=jsc,jec ; do i=isc,iec - CS%precip_cyc(i,j,m) = RZ_T_rescale * CS%precip_cyc(i,j,m) - enddo ; enddo ; enddo - endif - endif - - if ((CS%num_cycle > 0) .and. associated(CS%avg_time) .and. & - ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= 1.0)) ) then - ! Redo the scaling of the accumulated times to [T ~> s] - do m=1,CS%num_cycle - CS%avg_time(m) = (1.0 / US%s_to_T_restart) * CS%avg_time(m) - enddo - endif - - end subroutine controlled_forcing_init !> Clean up this modules control structure. diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index fcd40cf8da..05de663d46 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -243,7 +243,7 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< The thickness that is being - !! initialized [H ~> m or kg m-2]. + !! initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open @@ -288,12 +288,12 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, do j=js,je ; do i=is,ie e_interface = -depth_tot(i,j) do k=nz,2,-1 - h(i,j,k) = GV%Z_to_H * (e0(k) - e_interface) ! Nominal thickness + h(i,j,k) = e0(k) - e_interface ! Nominal thickness x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat r1 = sqrt((x-0.7)**2+(y-0.2)**2) r2 = sqrt((x-0.3)**2+(y-0.25)**2) - h(i,j,k) = h(i,j,k) + pert_amp * (e0(k) - e0(nz+1)) * GV%Z_to_H * & + h(i,j,k) = h(i,j,k) + pert_amp * (e0(k) - e0(nz+1)) * & (spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation if (h_noise /= 0.) then rns = initializeRandomNumberStream( int( 4096*(x + (y+1.)) ) ) @@ -301,11 +301,11 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, noise = h_noise * 2. * ( noise - 0.5 ) ! range -h_noise to h_noise h(i,j,k) = ( 1. + noise ) * h(i,j,k) endif - h(i,j,k) = max( GV%Angstrom_H, h(i,j,k) ) ! Limit to non-negative - e_interface = e_interface + GV%H_to_Z * h(i,j,k) ! Actual position of upper interface + h(i,j,k) = max( GV%Angstrom_Z, h(i,j,k) ) ! Limit to non-negative + e_interface = e_interface + h(i,j,k) ! Actual position of upper interface enddo - h(i,j,1) = GV%Z_to_H * (e0(1) - e_interface) ! Nominal thickness - h(i,j,1) = max( GV%Angstrom_H, h(i,j,1) ) ! Limit to non-negative + h(i,j,1) = e0(1) - e_interface ! Nominal thickness + h(i,j,1) = max( GV%Angstrom_Z, h(i,j,1) ) ! Limit to non-negative enddo ; enddo end subroutine Neverworld_initialize_thickness diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 62b55bb0a1..e0d2cafeae 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -39,7 +39,7 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -116,9 +116,9 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju eta1D(K) = eta_im(j,K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) endif enddo enddo ; enddo diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 9ff99b583f..4f213d86d9 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -40,7 +40,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] + intent(out) :: h !< The thickness that is being initialized [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will only read @@ -83,7 +83,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%Z_to_H + h(i,j,k) = h0 enddo enddo ; enddo @@ -94,7 +94,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%Z_to_H + h(i,j,k) = h0 enddo enddo ; enddo @@ -114,7 +114,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, intent(in) :: just_read !< If true, this call will @@ -125,7 +125,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] real :: T_range ! Range of temperatures over the vertical [C ~> degC] real :: zc ! Position of the middle of the cell [Z ~> m] - real :: zi ! Bottom interface position relative to the sea surface [H ~> m or kg m-2] + real :: zi ! Bottom interface position relative to the sea surface [Z ~> m] real :: dTdz ! Vertical temperature gradient [C Z-1 ~> degC m-1] character(len=40) :: verticalCoordinate @@ -149,8 +149,8 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & do j = G%jsc,G%jec ; do i = G%isc,G%iec zi = 0. do k = 1, nz - zi = zi - h(i,j,k) ! Bottom interface position - zc = GV%H_to_Z * (zi - 0.5*h(i,j,k)) ! Position of middle of cell + zi = zi - h(i,j,k) ! Bottom interface position + zc = zi - 0.5*h(i,j,k) ! Position of middle of cell zc = min( zc, -Hml(G, G%geoLatT(i,j)) ) ! Bound by depth of mixed layer T(i,j,k) = T_ref + dTdz * zc ! Linear temperature profile enddo diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 8df8f90e3d..7b1b4b3946 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -57,7 +57,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure logical, intent(in) :: just_read !< If present and true, this call @@ -108,7 +108,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) top = 0. ! Reference to surface bottom = 0. do k=1,nz - bottom = bottom - h(i,j,k)*GV%H_to_Z ! Interface below layer [Z ~> m] + bottom = bottom - h(i,j,k) ! Interface below layer [Z ~> m] zC = 0.5*( top + bottom ) ! Z of middle of layer [Z ~> m] DZ = min(0., zC + UpperLayerTempMLD) T(i,j,k) = max(LowerLayerMinTemp,LowerLayerTemp + LowerLayerdTdZ * DZ) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index a958ebdebb..58389b7b5c 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -36,7 +36,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will only read @@ -71,7 +71,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.just_read) & - call MOM_mesg("initialize_thickness_uniform: setting thickness") + call MOM_mesg("adjustment_initialize_thickness: setting thickness") ! Parameters used by main model initialization if (.not.just_read) call log_version(param_file, mdl, version, "") @@ -170,12 +170,12 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read do k=nz,1,-1 if (eta1D(k) > 0.) then eta1D(k) = max( eta1D(k+1) + min_thickness, 0. ) - h(i,j,k) = GV%Z_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) + h(i,j,k) = max( eta1D(k) - eta1D(k+1), min_thickness ) elseif (eta1D(k) <= (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%Z_to_H * min_thickness + h(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -187,7 +187,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read enddo do j=js,je ; do i=is,ie do k=nz,1,-1 - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) enddo enddo ; enddo @@ -209,7 +209,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: S !< The salinity that is being initialized [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. + intent(in) :: h !< The model thicknesses [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to @@ -275,7 +275,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, do j=js,je ; do i=is,ie eta1d(nz+1) = -depth_tot(i,j) do k=nz,1,-1 - eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_Z + eta1d(k) = eta1d(k+1) + h(i,j,k) enddo if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -296,7 +296,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, x = 1. - min(1., x) T(i,j,k) = T_range * x enddo - ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) + ! x = sum(T(i,j,:)*h(i,j,:)) ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) enddo ; enddo diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 2ff4e1ec80..e2c6182231 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -86,7 +86,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] + intent(in) :: h !< The model thicknesses [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -135,8 +135,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, fn = xs endif do k = nz, 1, -1 - zc = zi + 0.5*h(i,j,k)*GV%H_to_Z ! Position of middle of cell - zi = zi + h(i,j,k)*GV%H_to_Z ! Top interface position + zc = zi + 0.5*h(i,j,k) ! Position of middle of cell + zi = zi + h(i,j,k) ! Top interface position T(i,j,k) = T_ref + dTdz * zc & ! Linear temperature stratification + dTdx * x & ! Linear gradient + delta_T * fn ! Smooth fn of width L_zone diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 3920b52729..333f53895e 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -84,7 +84,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -184,9 +184,9 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e do k=1,nz ; e_pert(K) = 0.0 ; enddo - ! This sets the initial thickness (in [H ~> m or kg m-2]) of the layers. The thicknesses + ! This sets the initial thickness (in [Z ~> m]) of the layers. The thicknesses ! are set to insure that: - ! 1. each layer is at least GV%Angstrom_H thick, and + ! 1. each layer is at least GV%Angstrom_Z thick, and ! 2. the interfaces are where they should be based on the resting depths and ! interface height perturbations, as long at this doesn't interfere with 1. eta1D(nz+1) = -depth_tot(i,j) @@ -211,9 +211,9 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e if (eta1D(K) < eta1D(K+1) + GV%Angstrom_Z) & eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = max(GV%Z_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) + h(i,j,k) = max(eta1D(K) - eta1D(K+1), GV%Angstrom_Z) enddo - h(i,j,1) = max(GV%Z_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) + h(i,j,1) = max(0.0 - eta1D(2), GV%Angstrom_Z) enddo ; enddo diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 63c5c8a0d4..ab9ab385de 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -10,6 +10,7 @@ module circle_obcs_initialization use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -27,11 +28,12 @@ module circle_obcs_initialization contains !> This subroutine initializes layer thicknesses for the circle_obcs experiment. -subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. +subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -43,7 +45,7 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: IC_amp ! The amplitude of the initial height displacement [H ~> m or kg m-2]. + real :: IC_amp ! The amplitude of the initial height displacement [Z ~> m]. real :: diskrad ! Radius of the elevated disk [km] or [degrees] or [m] real :: rad ! Distance from the center of the elevated disk [km] or [degrees] or [m] real :: lonC ! The x-position of a point [km] or [degrees] or [m] @@ -73,7 +75,7 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus call get_param(param_file, mdl, "DISK_IC_AMPLITUDE", IC_amp, & "Initial amplitude of interface height displacements "//& "in the circle_obcs test case.", & - units='m', default=5.0, scale=GV%m_to_H, do_not_log=just_read) + units='m', default=5.0, scale=US%m_to_Z, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -88,9 +90,9 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) endif enddo enddo ; enddo diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 81aa4c2b3b..03cc983a9f 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -9,6 +9,7 @@ module dense_water_initialization use MOM_EOS, only : EOS_type use MOM_error_handler, only : MOM_error, FATAL use MOM_file_parser, only : get_param, param_file_type +use MOM_interface_heights, only : dz_to_thickness, dz_to_thickness_simple use MOM_grid, only : ocean_grid_type use MOM_sponge, only : sponge_CS use MOM_unit_scaling, only : unit_scale_type @@ -105,7 +106,7 @@ subroutine dense_water_initialize_TS(G, GV, US, param_file, T, S, h, just_read) type(param_file_type), intent(in) :: param_file !< Parameter file structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [Z ~> m] logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables @@ -137,7 +138,7 @@ subroutine dense_water_initialize_TS(G, GV, US, param_file, T, S, h, just_read) zi = 0. do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) + zmid = zi + 0.5 * h(i,j,k) / G%max_depth if (zmid < mld) then ! use reference salinity in the mixed layer @@ -147,7 +148,7 @@ subroutine dense_water_initialize_TS(G, GV, US, param_file, T, S, h, just_read) S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) + zi = zi + h(i,j,k) / G%max_depth enddo enddo enddo @@ -172,7 +173,8 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, real :: east_sponge_width ! The fraction of the domain in which the eastern (outflow) sponge is active [nondim] real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! sponge layer thicknesses in height units [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T ! sponge temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinity [S ~> ppt] real, dimension(SZK_(GV)+1) :: e0, eta1D ! interface positions for ALE sponge [Z ~> m] @@ -256,16 +258,14 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then ! is this layer vanished? eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + dz(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + dz(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo enddo - call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) - ! construct temperature and salinity for the sponge ! start with initial condition T(:,:,:) = T_ref @@ -277,7 +277,7 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) + zmid = zi + 0.5 * dz(i,j,k) / G%max_depth if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_frac) & @@ -288,11 +288,21 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) + zi = zi + dz(i,j,k) / G%max_depth enddo enddo enddo + ! Convert thicknesses from height units to thickness units + if (associated(tv%eqn_of_state)) then + call dz_to_thickness(dz, T, S, tv%eqn_of_state, h, G, GV, US) + else + call dz_to_thickness_simple(dz, h, G, GV, US, layer_mode=.true.) + endif + + ! This call sets up the damping rates and interface heights in the sponges. + call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp, 'temp', & sp_long_name='temperature', sp_unit='degC s-1') if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 0b65883eca..b2ed47f89b 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -9,6 +9,7 @@ module dumbbell_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : dz_to_thickness, dz_to_thickness_simple use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type use MOM_unit_scaling, only : unit_scale_type @@ -96,7 +97,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -126,7 +127,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.just_read) & - call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + call MOM_mesg("dumbbell_initialization.F90, dumbbell_initialize_thickness: setting thickness") if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & @@ -174,7 +175,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, enddo endif do k=1,nz - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) enddo enddo enddo @@ -217,9 +218,9 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -232,9 +233,9 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%Z_to_H * min_thickness + h(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -242,7 +243,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * depth_tot(i,j) / real(nz) + h(i,j,:) = depth_tot(i,j) / real(nz) enddo ; enddo end select @@ -255,7 +256,7 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: just_read !< If true, this call will @@ -349,8 +350,11 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil real :: sponge_time_scale ! The damping time scale [T ~> s] real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinities [S ~> ppt] + real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! Sponge thicknesses in height units [Z ~> m] + real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! Sponge thicknesses [H ~> m or kg m-2] + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! Sponge salinities [S ~> ppt] + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! Sponge tempertures [C ~> degC], used only to convert thicknesses + ! in non-Boussinesq mode real, dimension(SZK_(GV)+1) :: eta1D ! Interface positions for ALE sponge [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! A temporary array for interface heights [Z ~> m]. @@ -359,6 +363,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil real :: dblen ! The size of the dumbbell test case [km] or [m] real :: min_thickness ! The minimum layer thickness [Z ~> m] real :: S_ref, S_range ! A reference salinity and the range of salinities in this test case [S ~> ppt] + real :: T_surf ! The surface temperature [C ~> degC] logical :: dbrotate ! If true, rotate the domain. call get_param(param_file, mdl,"DUMBBELL_LEN",dblen, & @@ -377,6 +382,9 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil call get_param(param_file, mdl, "DUMBBELL_SPONGE_TIME_SCALE", sponge_time_scale, & "The time scale in the reservoir for restoring. If zero, the sponge is disabled.", & units="s", default=0., scale=US%s_to_T) + call get_param(param_file, mdl, "DUMBBELL_T_SURF", T_surf, & + 'Initial surface temperature in the DUMBBELL configuration', & + units='degC', default=20., scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, & 'DUMBBELL REFERENCE SALINITY', & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) @@ -419,18 +427,17 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%Z_to_H * min_thickness + dz(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + dz(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo - call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) - ! construct temperature and salinity for the sponge ! start with initial condition S(:,:,:) = 0.0 + T(:,:,:) = T_surf do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Compute normalized zonal coordinates (x,y=0 at center of domain) @@ -451,7 +458,18 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil enddo endif enddo ; enddo - if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & + + ! Convert thicknesses from height units to thickness units + if (associated(tv%eqn_of_state)) then + call dz_to_thickness(dz, T, S, tv%eqn_of_state, h, G, GV, US) + else + call dz_to_thickness_simple(dz, h, G, GV, US, layer_mode=.true.) + endif + + ! Store damping rates and the grid on which the T/S sponge data will reside + call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) + + if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & sp_long_name='salinity', sp_unit='g kg-1 s-1') else do j=G%jsc,G%jec ; do i=G%isc,G%iec diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 4ac5ab3bf9..ca383ba1f1 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -210,7 +210,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DUMBBELL_SLP_AMP", CS%slp_amplitude, & "Amplitude of SLP forcing in reservoirs.", & - units="Pa", default=10000.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=10000.0, scale=US%Pa_to_RL2_T2) call get_param(param_file, mdl, "DUMBBELL_SLP_PERIOD", CS%slp_period, & "Periodicity of SLP forcing in reservoirs.", & units="days", default=1.0) diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 63cc89342a..437edc49b2 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -30,7 +30,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will only read @@ -73,7 +73,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=1,nz - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) enddo enddo ; enddo diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 3b41237c36..ab08d4068d 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -28,7 +28,7 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will only read @@ -80,7 +80,7 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_Z ) enddo do k=nz,1,-1 - h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = eta1D(K) - eta1D(K+1) enddo enddo ; enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index a1f978a784..d1971f25f9 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -84,7 +84,7 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -105,7 +105,7 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.just_read) & - call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + call MOM_mesg("seamount_initialization.F90, seamount_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & 'Minimum thickness for layer', & @@ -164,9 +164,9 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H + h(i,j,k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -179,9 +179,9 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%Z_to_H * min_thickness + h(i,j,k) = min_thickness else - h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo enddo ; enddo @@ -189,7 +189,7 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * depth_tot(i,j) / real(nz) + h(i,j,:) = depth_tot(i,j) / real(nz) enddo ; enddo end select @@ -202,7 +202,7 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: just_read !< If true, this call will @@ -282,7 +282,7 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + GV%H_to_Z * h(i,j,k) / G%max_depth + xi1 = xi0 + h(i,j,k) / G%max_depth select case ( trim(density_profile) ) case ('linear') !S(i,j,k) = S_surf + S_range * 0.5 * (xi0 + xi1) diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 357f247896..75e5889092 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -57,7 +57,7 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure to parse for model parameter values. @@ -160,7 +160,7 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ! 4. Define layers do k = 1,nz - h(i,j,k) = GV%Z_to_H * (z_inter(k) - z_inter(k+1)) + h(i,j,k) = z_inter(k) - z_inter(k+1) enddo enddo ; enddo @@ -179,7 +179,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [Z ~> m]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse !! for model parameter values. diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index b3b45da997..06a781ec94 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -32,7 +32,7 @@ subroutine soliton_initialize_thickness(h, depth_tot, G, GV, US) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] @@ -55,7 +55,7 @@ subroutine soliton_initialize_thickness(h, depth_tot, G, GV, US) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2 * ( 2.0*val3 / (1.0 + (val3*val3)) )**2 - h(i,j,k) = GV%Z_to_H * (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + depth_tot(i,j)) + h(i,j,k) = (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + depth_tot(i,j)) enddo enddo ; enddo @@ -63,12 +63,11 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, h, G, GV, US) +subroutine soliton_initialize_velocity(u, v, G, GV, US) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index b9d16e548a..207f009c9c 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -76,12 +76,12 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth, US) end subroutine USER_initialize_topography -!> initialize thicknesses. +!> Initialize thicknesses in depth units. These will be converted to thickness units later. subroutine USER_initialize_thickness(h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thicknesses being initialized [H ~> m or kg m-2]. + intent(out) :: h !< The thicknesses being initialized [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will @@ -93,7 +93,8 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read) if (just_read) return ! All run-time parameters have been read, so return. - h(:,:,1) = 0.0 ! h should be set [H ~> m or kg m-2]. + h(:,:,1:GV%ke) = 0.0 ! h should be set in [Z ~> m]. It will be converted to thickness units + ! [H ~> m or kg m-2] once the temperatures and salinities are known. if (first_call) call write_user_log(param_file) From c57789f4145e5e7ea9079acd7e63a5e154172769 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 Aug 2023 15:08:29 -0600 Subject: [PATCH 206/213] Rearrange do-loops and if statements Follow Marshall Ward suggestion and rearrange the code to be closer to what the compilers will do (or we hope they would do). This commit aims to potentially enhance performance. Answers are bit-wise identical. --- src/tracer/MOM_neutral_diffusion.F90 | 66 +++++++++++++++++----------- 1 file changed, 40 insertions(+), 26 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 65e2232ab1..d0f75e8197 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -669,9 +669,9 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) ! x-flux if (CS%KhTh_use_ebt_struct) then - do j = G%jsc,G%jec ; do I = G%isc-1,G%iec - if (G%mask2dCu(I,j)>0.) then - if (CS%tapering) then + if (CS%tapering) then + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + if (G%mask2dCu(I,j)>0.) then ! compute coeff_l and coeff_r and pass them to neutral_surface_flux call compute_tapering_coeffs(G%ke+1, CS%hbl(I,j), CS%hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & h(I,j,:), h(I+1,j,:)) @@ -683,7 +683,11 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%continuous_reconstruction, h_neglect, & CS%remap_CS, h_neglect_edge, CS%coeff_l(:)*CS%Coef_h(i,j,:), & CS%coeff_r(:)*CS%Coef_h(i+1,j,:)) - else + endif + enddo ; enddo + else + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + if (G%mask2dCu(I,j)>0.) then call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & tracer%t(i,j,:), tracer%t(i+1,j,:), & CS%uPoL(I,j,:), CS%uPoR(I,j,:), & @@ -693,12 +697,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%remap_CS, h_neglect_edge, CS%Coef_h(i,j,:), & CS%Coef_h(i+1,j,:)) endif - endif - enddo ; enddo + enddo ; enddo + endif else - do j = G%jsc,G%jec ; do I = G%isc-1,G%iec - if (G%mask2dCu(I,j)>0.) then - if (CS%tapering) then + if (CS%tapering) then + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + if (G%mask2dCu(I,j)>0.) then ! compute coeff_l and coeff_r and pass them to neutral_surface_flux call compute_tapering_coeffs(G%ke+1, CS%hbl(I,j), CS%hbl(I+1,j), CS%coeff_l(:), CS%coeff_r(:), & h(I,j,:), h(I+1,j,:)) @@ -710,7 +714,11 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%continuous_reconstruction, h_neglect, & CS%remap_CS, h_neglect_edge, CS%coeff_l(:), & CS%coeff_r(:)) - else + endif + enddo ; enddo + else + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec + if (G%mask2dCu(I,j)>0.) then call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i+1,j,:), & tracer%t(i,j,:), tracer%t(i+1,j,:), & CS%uPoL(I,j,:), CS%uPoR(I,j,:), & @@ -719,15 +727,15 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%continuous_reconstruction, h_neglect, & CS%remap_CS, h_neglect_edge) endif - endif - enddo ; enddo + enddo ; enddo + endif endif ! y-flux if (CS%KhTh_use_ebt_struct) then - do J = G%jsc-1,G%jec ; do i = G%isc,G%iec - if (G%mask2dCv(i,J)>0.) then - if (CS%tapering) then + if (CS%tapering) then + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + if (G%mask2dCv(i,J)>0.) then ! compute coeff_l and coeff_r and pass them to neutral_surface_flux call compute_tapering_coeffs(G%ke+1, CS%hbl(i,J), CS%hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & h(i,J,:), h(i,J+1,:)) @@ -740,8 +748,11 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%continuous_reconstruction, h_neglect, & CS%remap_CS, h_neglect_edge, CS%coeff_l(:)*CS%Coef_h(i,j,:), & CS%coeff_r(:)*CS%Coef_h(i,j+1,:)) - else - + endif + enddo ; enddo + else + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + if (G%mask2dCv(i,J)>0.) then call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & tracer%t(i,j,:), tracer%t(i,j+1,:), & CS%vPoL(i,J,:), CS%vPoR(i,J,:), & @@ -751,12 +762,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%remap_CS, h_neglect_edge, CS%Coef_h(i,j,:), & CS%Coef_h(i,j+1,:)) endif - endif - enddo ; enddo + enddo ; enddo + endif else - do J = G%jsc-1,G%jec ; do i = G%isc,G%iec - if (G%mask2dCv(i,J)>0.) then - if (CS%tapering) then + if (CS%tapering) then + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + if (G%mask2dCv(i,J)>0.) then ! compute coeff_l and coeff_r and pass them to neutral_surface_flux call compute_tapering_coeffs(G%ke+1, CS%hbl(i,J), CS%hbl(i,J+1), CS%coeff_l(:), CS%coeff_r(:), & h(i,J,:), h(i,J+1,:)) @@ -769,8 +780,11 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%continuous_reconstruction, h_neglect, & CS%remap_CS, h_neglect_edge, CS%coeff_l(:), & CS%coeff_r(:)) - else - + endif + enddo ; enddo + else + do J = G%jsc-1,G%jec ; do i = G%isc,G%iec + if (G%mask2dCv(i,J)>0.) then call neutral_surface_flux(nk, CS%nsurf, CS%deg, h(i,j,:), h(i,j+1,:), & tracer%t(i,j,:), tracer%t(i,j+1,:), & CS%vPoL(i,J,:), CS%vPoR(i,J,:), & @@ -779,8 +793,8 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) CS%continuous_reconstruction, h_neglect, & CS%remap_CS, h_neglect_edge) endif - endif - enddo ; enddo + enddo ; enddo + endif endif ! Update the tracer concentration from divergence of neutral diffusive flux components From d4aa10857b7679701fdbd44ea67adc6213c0800c Mon Sep 17 00:00:00 2001 From: Ian Grooms Date: Tue, 29 Aug 2023 09:39:55 -0600 Subject: [PATCH 207/213] Add Leith+E (#251) * Add Leith+E This commit adds the 2D Leith+E closure, which uses a modified 2D Leith biharmonic viscosity paired with a harmonic backscatter. ('Modified' here is not used in the same sense as 'modified 2D Leith'; it just means that the biharmonic coefficient is modified to account for enstrophy backscatter.) Variables are often named 'leithy' to refer to Leith+E. The parameterization is controlled by three main entries in user_nl_mom: 1. USE_LEITHY = True 2. LEITH_CK = 1.0 3. LEITH_BI_CONST = 8.0 To use Leith+E you should have LAPLACIAN=True and BIHARMONIC=True. (It doesn't hurt to be explicit and also set LEITH_AH=False, along with any other viscous closures, but this is not required. If USE_LEITHY=True it will not use any of the other schemes. It does use the background value of the biharmonic coefficient as a minimum, but ignores the background harmonic value.) LEITH_CK is the fraction of energy dissipated by the biharmonic term that gets backscattered by the harmonic term (it's a target; the backscatter rate is not exact.) Recommended values between 0 and 1. LEITH_BI_CONST is Upsilon^6 where Upsilon is the ratio between the grid scale and the dissipation scale for enstrophy. Values should be greater than or equal to 1; 8 is a good place to start. The code is sensitive to the background value of Ah; specifically, if Ah is too large, the code is unstable. This is because the backscatter coefficient is proportional to Ah, and if Ah is large then you get large backscatter. If your code is unstable, consider reducing, e.g., `AH_VEL_SCALE`. * Background Ah This commit updates the code so that it uses the background Ah as a minimum. Previously, if `SMAGORINSKY_AH = True`, Leith+E would use the Smag value of Ah as the minimum, which is incorrect. * Improve logging Removed `do_not_log` condition on `USE_LEITHY` * Fix Leithy Logic Added one line to fix the fact that the code would only work as intended if either (i) writing out Ah_h, or (ii) in debug mode. Also swapped .le. and .lt. for <= and <. --- .../lateral/MOM_hor_visc.F90 | 379 ++++++++++++++++-- 1 file changed, 345 insertions(+), 34 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 9037c71c5a..5bd3809a85 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -69,6 +69,11 @@ module MOM_hor_visc logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity logical :: Leith_Ah !< If true, use a biharmonic form of 2D Leith !! nonlinear eddy viscosity. AH is the background. + logical :: use_Leithy !< If true, use a biharmonic form of 2D Leith + !! nonlinear eddy viscosity with harmonic backscatter. + !! Ah is the background. Leithy = Leith+E + real :: c_K !< Fraction of energy dissipated by the biharmonic term + !! that gets backscattered in the Leith+E scheme. [nondim] logical :: use_QG_Leith_visc !< If true, use QG Leith nonlinear eddy viscosity. !! KH is the background value. logical :: bound_Coriolis !< If true & SMAGORINSKY_AH is used, the biharmonic @@ -149,10 +154,12 @@ module MOM_hor_visc n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points [nondim] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] - dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] - dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] - dy_dxT !< Pre-calculated dy/dx at h points [nondim] + dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] + dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] + dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] + dy_dxT, & !< Pre-calculated dy/dx at h points [nondim] + m_const_leithy, & !< Pre-calculated .5*sqrt(c_K)*max{dx,dy} [L ~> m] + m_leithy_max !< Pre-calculated 4./max(dx,dy)^2 at h points [L-2 ~> m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & dx2q, & !< Pre-calculated dx^2 at q points [L2 ~> m2] dy2q, & !< Pre-calculated dy^2 at q points [L2 ~> m2] @@ -261,18 +268,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Del2u, & ! The u-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + vort_xy_dy_smooth, & ! y-derivative of smoothed vertical vorticity [L-1 T-1 ~> m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - ubtav ! zonal barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] + ubtav, & ! zonal barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] + u_smooth ! Zonal velocity, smoothed with a spatial low-pass filter [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & Del2v, & ! The v-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + vort_xy_dx_smooth, & ! x-derivative of smoothed vertical vorticity [L-1 T-1 ~> m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - vbtav ! meridional barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] + vbtav, & ! meridional barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] + v_smooth ! Meridional velocity, smoothed with a spatial low-pass filter [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + sh_xx_smooth, & ! horizontal tension from smoothed velocity including metric terms [T-1 ~> s-1] sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2], but ! at some points in the code it is not yet layer integrated, so is in [L2 T-2 ~> m2 s-2]. @@ -283,23 +295,28 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1] + dudx_smooth, dvdy_smooth, & ! components in the horizontal tension from smoothed velocity [T-1 ~> s-1] GME_effic_h, & ! The filtered efficiency of the GME terms at h points [nondim] - htot ! The total thickness of all layers [Z ~> m] + htot, & ! The total thickness of all layers [Z ~> m] + m_leithy ! Kh=m_leithy*Ah in Leith+E parameterization [L-2 ~> m-2] real :: Del2vort_h ! Laplacian of vorticity at h-points [L-2 T-1 ~> m-2 s-1] real :: grad_vel_mag_bt_h ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] real :: boundary_mask_h ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [T-1 ~> s-1] + dvdx_smooth, dudy_smooth, & ! components in the shearing strain from smoothed velocity [T-1 ~> s-1] dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 ~> s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + sh_xy_smooth, & ! horizontal shearing strain from smoothed velocity including metric terms [T-1 ~> s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2], but ! at some points in the code it is not yet layer integrated, so is in [L2 T-2 ~> m2 s-2]. str_xy_GME, & ! smoothed cross term in the stress tensor from GME [L2 T-2 ~> m2 s-2] bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] + vort_xy_smooth, & ! Vertical vorticity including metric terms, smoothed [T-1 ~> s-1] grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] Del2vort_q, & ! Laplacian of vorticity at q-points [L-2 T-1 ~> m-2 s-1] @@ -346,6 +363,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: AhLthy ! 2D Leith+E biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Shear_mag_bc ! Shear_mag value in backscatter [T-1 ~> s-1] real :: sh_xx_sq ! Square of tension (sh_xx) [T-2 ~> s-2] real :: sh_xy_sq ! Square of shearing strain (sh_xy) [T-2 ~> s-2] @@ -397,6 +415,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Kh, & ! Laplacian viscosity (h or q) [L2 T-1 ~> m2 s-1] Shear_mag, & ! magnitude of the shear (h or q) [T-1 ~> s-1] vert_vort_mag, & ! magnitude of the vertical vorticity gradient (h or q) [L-1 T-1 ~> m-1 s-1] + vert_vort_mag_smooth, & ! magnitude of gradient of smoothed vertical vorticity (h or q) [L-1 T-1 ~> m-1 s-1] hrat_min, & ! h_min divided by the thickness at the stress point (h or q) [nondim] visc_bound_rem ! fraction of overall viscous bounds that remain to be applied (h or q) [nondim] @@ -409,6 +428,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, inv_PI2 = 1.0/((4.0*atan(1.0))**2) inv_PI6 = inv_PI3 * inv_PI3 + m_leithy(:,:) = 0. ! Initialize + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally apply_OBC = .true. @@ -561,7 +582,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP grid_Ah, grid_Kh, d_Del2u, d_Del2v, d_str, & !$OMP Kh, Ah, AhSm, AhLth, local_strain, Sh_F_pow, & !$OMP dDel2vdx, dDel2udy, Del2vort_q, Del2vort_h, KE, & - !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff & + !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff, & + !$OMP dudx_smooth, dudy_smooth, dvdx_smooth, dvdy_smooth, & + !$OMP vort_xy_smooth, vort_xy_dx_smooth, vort_xy_dy_smooth, & + !$OMP sh_xx_smooth, sh_xy_smooth, u_smooth, v_smooth, & + !$OMP vert_vort_mag_smooth, m_leithy, AhLthy & !$OMP ) do k=1,nz @@ -590,6 +615,30 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo + if (CS%use_Leithy) then + ! Smooth the velocity. Right now it happens twice. In the future + ! one might make the number of smoothing cycles a user-specified parameter + u_smooth(:,:) = u(:,:,k) + v_smooth(:,:) = v(:,:,k) + call smooth_x9(CS, G, field_u=u_smooth,field_v=v_smooth) ! one call applies the filter twice + ! Calculate horizontal tension from smoothed velocity + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + dudx_smooth(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u_smooth(I,j) - & + G%IdyCu(I-1,j) * u_smooth(I-1,j)) + dvdy_smooth(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v_smooth(i,J) - & + G%IdxCv(i,J-1) * v_smooth(i,J-1)) + sh_xx_smooth(i,j) = dudx_smooth(i,j) - dvdy_smooth(i,j) + enddo ; enddo + + ! Components for the shearing strain from smoothed velocity + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + dvdx_smooth(I,J) = CS%DY_dxBu(I,J) * & + (v_smooth(i+1,J)*G%IdyCv(i+1,J) - v_smooth(i,J)*G%IdyCv(i,J)) + dudy_smooth(I,J) = CS%DX_dyBu(I,J) * & + (u_smooth(I,j+1)*G%IdxCu(I,j+1) - u_smooth(I,j)*G%IdxCu(I,j)) + enddo ; enddo + end if ! use Leith+E + if (CS%id_normstress > 0) then do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 NoSt(i,j,k) = sh_xx(i,j) @@ -743,6 +792,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif + if (CS%use_Leithy) then + ! Shearing strain (including no-slip boundary conditions at the 2-D land-sea mask). + ! dudy_smooth and dvdx_smooth do not (yet) include modifications at OBCs from above. + if (CS%no_slip) then + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + sh_xy_smooth(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_smooth(I,J) + dudy_smooth(I,J) ) + enddo ; enddo + else + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + sh_xy_smooth(I,J) = G%mask2dBu(I,J) * ( dvdx_smooth(I,J) + dudy_smooth(I,J) ) + enddo ; enddo + endif + endif ! use Leith+E + ! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -780,12 +843,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif + if (CS%use_Leithy) then + if (CS%no_slip) then + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + vort_xy_smooth(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_smooth(I,J) - dudy_smooth(I,J) ) + enddo ; enddo + else + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 + vort_xy_smooth(I,J) = G%mask2dBu(I,J) * ( dvdx_smooth(I,J) - dudy_smooth(I,J) ) + enddo ; enddo + endif + endif + ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 div_xx(i,j) = dudx(i,j) + dvdy(i,j) enddo ; enddo - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + if ((CS%Leith_Kh) .or. (CS%Leith_Ah) .or. (CS%use_Leithy)) then ! Vorticity gradient do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 @@ -798,6 +873,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo + if (CS%use_Leithy) then + ! Gradient of smoothed vorticity + do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + vort_xy_dx_smooth(i,J) = DY_dxBu * & + (vort_xy_smooth(I,J) * G%IdyCu(I,j) - vort_xy_smooth(I-1,J) * G%IdyCu(I-1,j)) + enddo ; enddo + + do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1 + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + vort_xy_dy_smooth(I,j) = DX_dyBu * & + (vort_xy_smooth(I,J) * G%IdxCv(i,J) - vort_xy_smooth(I,J-1) * G%IdxCv(i,J-1)) + enddo ; enddo + endif ! If Leithy + ! Laplacian of vorticity do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) @@ -880,6 +970,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo + if (CS%use_Leithy) then + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + vert_vort_mag_smooth(i,j) = SQRT((0.5*(vort_xy_dx_smooth(i,J) + & + vort_xy_dx_smooth(i,J-1)))**2 + & + (0.5*(vort_xy_dy_smooth(I,j) + & + vort_xy_dy_smooth(I-1,j)))**2 ) + enddo ; enddo + endif ! Leithy + endif ! CS%Leith_Kh if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then @@ -905,6 +1004,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%Laplacian) then + ! Determine the Laplacian viscosity at h points, using the + ! largest value from several parameterizations. Also get + ! the Laplacian component of str_xx. + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -919,9 +1022,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - ! Determine the Laplacian viscosity at h points, using the - ! largest value from several parameterizations. - ! Static (pre-computed) background viscosity do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 Kh(i,j) = CS%Kh_bg_xx(i,j) @@ -995,6 +1095,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif + ! In Leith+E parameterization Kh is computed after Ah in the biharmonic loop. + ! The harmonic component of str_xx is added in the biharmonic loop. + if (CS%use_Leithy) then + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Kh(i,j) = 0. + enddo ; enddo + end if + if (CS%id_Kh_h>0 .or. CS%debug) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 Kh_h(i,j,k) = Kh(i,j) @@ -1028,7 +1136,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = 0.0 enddo ; enddo - endif + endif ! Get Kh at h points and get Laplacian component of str_xx if (CS%anisotropic) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1041,12 +1149,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Determine the biharmonic viscosity at h points, using the - ! largest value from several parameterizations. + ! largest value from several parameterizations. Also get the + ! biharmonic component of str_xx. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 Ah(i,j) = CS%Ah_bg_xx(i,j) enddo ; enddo - if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then + if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah) .or. (CS%use_Leithy)) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1072,12 +1181,50 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif + if (CS%use_Leithy) then + ! Get m_leithy + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Del2vort_h = 0.25 * ((Del2vort_q(I,J) + Del2vort_q(I-1,J-1)) + & + (Del2vort_q(I-1,J) + Del2vort_q(I,J-1))) + AhLth = CS%Biharm6_const_xx(i,j) * inv_PI6 * abs(Del2vort_h) + if (AhLth <= CS%Ah_bg_xx(i,j)) then + m_leithy(i,j) = 0.0 + else + if ((CS%m_const_leithy(i,j)*vert_vort_mag(i,j)) < abs(vort_xy_smooth(i,j))) then + m_leithy(i,j) = CS%c_K * (vert_vort_mag(i,j) / vort_xy_smooth(i,j))**2 + else + m_leithy(i,j) = CS%m_leithy_max(i,j) + endif + endif + enddo ; enddo + ! Smooth m_leithy + call smooth_x9(CS, G, field_h=m_leithy, zero_land=.true.) + ! Get Ah + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Del2vort_h = 0.25 * ((Del2vort_q(I,J) + Del2vort_q(I-1,J-1)) + & + (Del2vort_q(I-1,J) + Del2vort_q(I,J-1))) + AhLthy = CS%Biharm6_const_xx(i,j) * inv_PI6 * & + sqrt(max(0.,Del2vort_h**2 - m_leithy(i,j)*vert_vort_mag_smooth(i,j)**2)) + Ah(i,j) = max(CS%Ah_bg_xx(i,j), AhLthy) + enddo ; enddo + ! Smooth Ah before applying upper bound + ! square, then smooth, then square root + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Ah_h(i,j,k) = Ah(i,j)**2 + enddo ; enddo + call smooth_x9(CS, G, field_h=Ah_h(:,:,k)) + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Ah_h(i,j,k) = sqrt(Ah_h(i,j,k)) + Ah(i,j) = Ah_h(i,j,k) + enddo ; enddo + endif + if (CS%bound_Ah .and. .not. CS%better_bound_Ah) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 Ah(i,j) = min(Ah(i,j), CS%Ah_Max_xx(i,j)) enddo ; enddo endif - endif ! Smagorinsky_Ah or Leith_Ah + endif ! Smagorinsky_Ah or Leith_Ah or Leith+E if (use_MEKE_Au) then ! *Add* the MEKE contribution @@ -1111,6 +1258,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif + if (CS%use_Leithy) then + ! Compute Leith+E Kh after bounds have been applied to Ah + ! and after it has been smoothed. Kh = -m_leithy * Ah + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Kh(i,j) = -m_leithy(i,j) * Ah(i,j) + Kh_h(i,j,k) = Kh(i,j) + enddo ; enddo + endif + if (CS%id_grid_Re_Ah>0) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 KE = 0.125 * ((u(I,j,k) + u(I-1,j,k))**2 + (v(i,J,k) + v(i,J-1,k))**2) @@ -1126,10 +1282,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, str_xx(i,j) = str_xx(i,j) + d_str + if (CS%use_Leithy) str_xx(i,j) = str_xx(i,j) - Kh(i,j) * sh_xx_smooth(i,j) + ! Keep a copy of the biharmonic contribution for backscatter parameterization bhstr_xx(i,j) = d_str * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo - endif + endif ! Get biharmonic coefficient at h points and biharmonic part of str_xx if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term @@ -1218,6 +1376,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%Laplacian) then + ! Determine the Laplacian viscosity at q points, using the + ! largest value from several parameterizations. Also get the + ! Laplacian component of str_xy. + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then do J=js-1,Jeq ; do I=is-1,Ieq @@ -1232,9 +1394,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - ! Determine the Laplacian viscosity at q points, using the - ! largest value from several parameterizations. - ! Static (pre-computed) background viscosity do J=js-1,Jeq ; do I=is-1,Ieq Kh(I,J) = CS%Kh_bg_xy(I,J) @@ -1301,6 +1460,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif + ! Leith+E doesn't recompute Kh at q points, it just interpolates it from h to q points + if (CS%use_Leithy) then + Kh(I,J) = Kh_h(i+1,j+1,k) + end if + if (CS%id_Kh_q>0 .or. CS%debug) & Kh_q(I,J,k) = Kh(I,J) @@ -1311,14 +1475,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, sh_xy_q(I,J,k) = sh_xy(I,J) enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq - str_xy(I,J) = -Kh(I,J) * sh_xy(I,J) - enddo ; enddo + if ( .not. CS%use_Leithy) then + do J=js-1,Jeq ; do I=is-1,Ieq + str_xy(I,J) = -Kh(I,J) * sh_xy(I,J) + enddo ; enddo + else + do J=js-1,Jeq ; do I=is-1,Ieq + str_xy(I,J) = -Kh(I,J) * sh_xy_smooth(I,J) + enddo ; enddo + endif else do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = 0. enddo ; enddo - endif + endif ! get harmonic coefficient Kh at q points and harmonic part of str_xy if (CS%anisotropic) then do J=js-1,Jeq ; do I=is-1,Ieq @@ -1331,7 +1501,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Determine the biharmonic viscosity at q points, using the - ! largest value from several parameterizations. + ! largest value from several parameterizations. Also get the + ! biharmonic component of str_xy. do J=js-1,Jeq ; do I=is-1,Ieq Ah(I,J) = CS%Ah_bg_xy(I,J) enddo ; enddo @@ -1395,6 +1566,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif + ! Leith+E doesn't recompute Ah at q points, it just interpolates it from h to q points + if (CS%use_Leithy) then + do J=js-1,Jeq ; do I=is-1,Ieq + Ah(I,J) = Ah_h(i+1,j+1,k) + enddo ; enddo + end if + if (CS%id_Ah_q>0 .or. CS%debug) then do J=js-1,Jeq ; do I=is-1,Ieq Ah_q(I,J,k) = Ah(I,J) @@ -1410,7 +1588,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Keep a copy of the biharmonic contribution for backscatter parameterization bhstr_xy(I,J) = d_str * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) enddo ; enddo - endif + endif ! Get Ah at q points and biharmonic part of str_xy if (CS%use_GME) then ! The wider halo here is to permit one pass of smoothing without a halo update. @@ -1937,6 +2115,10 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "If true, use a biharmonic Leith nonlinear eddy "//& "viscosity.", default=.false., do_not_log=.not.CS%biharmonic) if (.not.CS%biharmonic) CS%Leith_Ah = .false. + call get_param(param_file, mdl, "USE_LEITHY", CS%use_Leithy, & + "If true, use a biharmonic Leith nonlinear eddy "//& + "viscosity together with a harmonic backscatter.", & + default=.false.) call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& "to be stable.", default=.true., do_not_log=.not.CS%biharmonic) @@ -1995,12 +2177,11 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "Coriolis acceleration. The default is set by MAXVEL.", & units="m s-1", default=maxvel*US%L_T_to_m_s, scale=US%m_s_to_L_T, & do_not_log=.not.(CS%Smagorinsky_Ah .and. CS%bound_Coriolis)) - call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & "The nondimensional biharmonic Leith constant, "//& "typical values are thus far undetermined.", units="nondim", default=0.0, & - fail_if_missing=CS%Leith_Ah, do_not_log=.not.CS%Leith_Ah) - + fail_if_missing=(CS%Leith_Ah .or. CS%use_Leithy), & + do_not_log=.not.(CS%Leith_Ah .or. CS%use_Leithy)) call get_param(param_file, mdl, "USE_LAND_MASK_FOR_HVISC", CS%use_land_mask, & "If true, use the land mask for the computation of thicknesses "//& "at velocity locations. This eliminates the dependence on arbitrary "//& @@ -2032,6 +2213,16 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "with the Gent and McWilliams parameterization.", default=.false.) call get_param(param_file, mdl, "SPLIT", split, & "Use the split time stepping if true.", default=.true., do_not_log=.true.) + if (CS%use_Leithy) then + if (.not.(CS%biharmonic .and. CS%Laplacian)) then + call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& + "LAPLACIAN and BIHARMONIC must both be True when USE_LEITHY=True.") + endif + call get_param(param_file, mdl, "LEITHY_CK", CS%c_K, & + "Fraction of biharmonic dissipation that gets backscattered, "//& + "in Leith+E.", units="nondim", default=1.0) + endif + if (CS%use_GME .and. .not.split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & "cannot be used with SPLIT=False.") @@ -2150,9 +2341,13 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) ALLOC_(CS%Biharm_const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_const2_xy(:,:) = 0.0 endif endif - if (CS%Leith_Ah) then - ALLOC_(CS%biharm6_const_xx(isd:ied,jsd:jed)) ; CS%biharm6_const_xx(:,:) = 0.0 - ALLOC_(CS%biharm6_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm6_const_xy(:,:) = 0.0 + if ((CS%Leith_Ah) .or. (CS%use_Leithy)) then + ALLOC_(CS%biharm6_const_xx(isd:ied,jsd:jed)) ; CS%biharm6_const_xx(:,:) = 0.0 + ALLOC_(CS%biharm6_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm6_const_xy(:,:) = 0.0 + endif + if (CS%use_Leithy) then + ALLOC_(CS%m_const_leithy(isd:ied,jsd:jed)) ; CS%m_const_leithy(:,:) = 0.0 + ALLOC_(CS%m_leithy_max(isd:ied,jsd:jed)) ; CS%m_leithy_max(:,:) = 0.0 endif if (CS%Re_Ah > 0.0) then ALLOC_(CS%Re_Ah_const_xx(isd:ied,jsd:jed)); CS%Re_Ah_const_xx(:,:) = 0.0 @@ -2295,6 +2490,11 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) if (CS%Leith_Ah) then CS%biharm6_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h3) endif + if (CS%use_Leithy) then + CS%biharm6_const_xx(i,j) = Leith_bi_const * max(G%dxT(i,j),G%dyT(i,j))**6 + CS%m_const_leithy(i,j) = 0.5 * sqrt(CS%c_K) * max(G%dxT(i,j),G%dyT(i,j)) + CS%m_leithy_max(i,j) = 4. / max(G%dxT(i,j),G%dyT(i,j))**2 + endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (CS%Re_Ah > 0.0) CS%Re_Ah_const_xx(i,j) = grid_sp_h3 / CS%Re_Ah if (Ah_time_scale > 0.) CS%Ah_bg_xx(i,j) = & @@ -2317,7 +2517,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif - if (CS%Leith_Ah) then + if ((CS%Leith_Ah) .or. (CS%use_Leithy))then CS%biharm6_const_xy(I,J) = Leith_bi_const * (grid_sp_q3 * grid_sp_q3) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) @@ -2659,6 +2859,113 @@ subroutine smooth_GME(CS, G, GME_flux_h, GME_flux_q) enddo ! s-loop end subroutine smooth_GME +!> Apply a 9-point smoothing filter twice to reduce horizontal two-grid-point noise +!! Note that this subroutine does not conserve mass or angular momentum, so don't use it +!! in situations where you need conservation. Also can't apply it to Ah and Kh in the +!! horizontal_viscosity subroutine because they are not supposed to be halo-updated. +!! But you _can_ apply them to Kh_h and Ah_h. +subroutine smooth_x9(CS, G, field_h, field_u, field_v, field_q, zero_land) + type(hor_visc_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: field_h !< field to be smoothed + !! at h points + real, dimension(SZIB_(G),SZJ_(G)), optional, intent(inout) :: field_u !< field to be smoothed + !! at u points + real, dimension(SZI_(G),SZJB_(G)), optional, intent(inout) :: field_v !< field to be smoothed + !! at v points + real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: field_q !< field to be smoothed + !! at q points + logical, optional, intent(in) :: zero_land !< An optional argument + !! indicating whether to set values + !! on land to zero (.true.) or + !! whether to ignore land values + !! (.false. or not present) + ! local variables. It would be good to make the _original variables allocatable. + real, dimension(SZI_(G),SZJ_(G)) :: field_h_original + real, dimension(SZIB_(G),SZJ_(G)) :: field_u_original + real, dimension(SZI_(G),SZJB_(G)) :: field_v_original + real, dimension(SZIB_(G),SZJB_(G)) :: field_q_original + real, dimension(3,3) :: weights, local_weights ! averaging weights for smoothing, nondimensional + logical :: zero_land_val ! actual value of zero_land optional argument + integer :: i, j, s + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq + + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + weights = reshape([1., 2., 1., 2., 4., 2., 1., 2., 1.],shape(weights))/16. + + if (present(zero_land)) then + zero_land_val = zero_land + else + zero_land_val = .false. + endif + + if (present(field_h)) then + call pass_var(field_h, G%Domain, halo=2) ! Halo size 2 ensures that you can smooth twice + do s=1,0,-1 + field_h_original(:,:) = field_h(:,:) + ! apply smoothing on field_h + do j=js-s,je+s ; do i=is-s,ie+s + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + ! compute local weights + local_weights = weights*G%mask2dT(i-1:i+1,j-1:j+1) + if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16) + field_h(i,j) = sum(local_weights*field_h_original(i-1:i+1,j-1:j+1)) + enddo ; enddo + enddo + call pass_var(field_h, G%Domain) + endif + + if (present(field_u)) then + call pass_vector(field_u, field_v, G%Domain, halo=2) + do s=1,0,-1 + field_u_original(:,:) = field_u(:,:) + ! apply smoothing on field_u + do j=js-s,je+s ; do I=Isq-s,Ieq+s + ! skip land points + if (G%mask2dCu(I,j)==0.) cycle + ! compute local weights + local_weights = weights*G%mask2dCu(I-1:I+1,j-1:j+1) + if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16) + field_u(I,j) = sum(local_weights*field_u_original(I-1:I+1,j-1:j+1)) + enddo ; enddo + + field_v_original(:,:) = field_v(:,:) + ! apply smoothing on field_v + do J=Jsq-s,Jeq+s ; do i=is-s,ie+s + ! skip land points + if (G%mask2dCv(i,J)==0.) cycle + ! compute local weights + local_weights = weights*G%mask2dCv(i-1:i+1,J-1:J+1) + if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16) + field_v(i,J) = sum(local_weights*field_v_original(i-1:i+1,J-1:J+1)) + enddo ; enddo + enddo + call pass_vector(field_u, field_v, G%Domain) + endif + + if (present(field_q)) then + call pass_var(field_q, G%Domain, halo=2, position=CORNER) + do s=1,0,-1 + field_q_original(:,:) = field_q(:,:) + ! apply smoothing on field_q + do J=Jsq-s,Jeq+s ; do I=Isq-s,Ieq+s + ! skip land points + if (G%mask2dBu(I,J)==0.) cycle + ! compute local weights + local_weights = weights*G%mask2dBu(I-1:I+1,J-1:J+1) + if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16) + field_q(I,J) = sum(local_weights*field_q_original(I-1:I+1,J-1:J+1)) + enddo ; enddo + enddo + call pass_var(field_q, G%Domain, position=CORNER) + endif + +end subroutine smooth_x9 + !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure @@ -2691,9 +2998,13 @@ subroutine hor_visc_end(CS) if (CS%Smagorinsky_Ah) then DEALLOC_(CS%Biharm_const_xx) ; DEALLOC_(CS%Biharm_const_xy) endif - if (CS%Leith_Ah) then + if ((CS%Leith_Ah) .or. (CS%use_Leithy)) then DEALLOC_(CS%Biharm6_const_xx) ; DEALLOC_(CS%Biharm6_const_xy) endif + if (CS%use_Leithy) then + DEALLOC_(CS%m_const_leithy) + DEALLOC_(CS%m_leithy_max) + endif if (CS%Re_Ah > 0.0) then DEALLOC_(CS%Re_Ah_const_xx) ; DEALLOC_(CS%Re_Ah_const_xy) endif From 7b7052e9b691468e650686d9ba38dade5c5b4ed5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 6 Sep 2023 13:55:23 -0600 Subject: [PATCH 208/213] Describe local variables and make code consistent --- .../vertical/MOM_vert_friction.F90 | 169 ++++++++---------- 1 file changed, 75 insertions(+), 94 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5a62e835f8..eab2f2d29d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -166,7 +166,7 @@ module MOM_vert_friction integer :: id_au_vv = -1, id_av_vv = -1, id_au_gl90_vv = -1, id_av_gl90_vv = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 - integer :: id_FPdiag_u = -1, id_FPdiag_v = -1 , id_FPw2x = -1 !W id_FPhbl_u = -1, id_FPhbl_v = -1 + integer :: id_FPw2x = -1 !W id_FPhbl_u = -1, id_FPhbl_v = -1 integer :: id_tauFP_u = -1, id_tauFP_v = -1 !W, id_FPtau2x_u = -1, id_FPtau2x_v = -1 integer :: id_FPtau2s_u = -1, id_FPtau2s_v = -1, id_FPtau2w_u = -1, id_FPtau2w_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 @@ -210,47 +210,40 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! local variables - ! WGL; TODO: add description to local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: FPdiag_u !< this is for ... - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: FPdiag_v - real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u - real, dimension(SZI_(G),SZJB_(G)) :: hbl_v - integer, dimension(SZIB_(G),SZJ_(G)) :: kbl_u - integer, dimension(SZI_(G),SZJB_(G)) :: kbl_v - real, dimension(SZIB_(G),SZJ_(G)) :: ustar2_u - real, dimension(SZI_(G),SZJB_(G)) :: ustar2_v - real, dimension(SZIB_(G),SZJ_(G)) :: taux_u - real, dimension(SZI_(G),SZJB_(G)) :: tauy_v - real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u - real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v - - ! GMM; TODO: make arrays allocatable if possible - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tau_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tau_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauxDG_u - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauyDG_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauxDG_v - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauyDG_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2s_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2s_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2w_u - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2w_v - - real :: pi, Cemp_CG, tmp, cos_tmp, sin_tmp, omega_tmp - real :: du, dv, depth, sigma, Wind_x, Wind_y - real :: taux, tauy, tauxDG, tauyDG, tauxDGup, tauyDGup, ustar2, tauh - real :: tauNLup, tauNLdn, tauNL_CG, tauNL_DG, tauNL_X, tauNL_Y, tau_MAG - real :: omega_w2s, omega_tau2s, omega_s2x, omega_tau2x, omega_tau2w, omega_s2w - integer :: kblmin, kbld, kp1 - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u !< boundary layer depth at u-pts [H ~> m] + real, dimension(SZI_(G),SZJB_(G)) :: hbl_v !< boundary layer depth at v-pts [H ~> m] + integer, dimension(SZIB_(G),SZJ_(G)) :: kbl_u !< index of the BLD at u-pts [nondim] + integer, dimension(SZI_(G),SZJB_(G)) :: kbl_v !< index of the BLD at v-pts [nondim] + real, dimension(SZIB_(G),SZJ_(G)) :: ustar2_u !< ustar squared at u-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJB_(G)) :: ustar2_v !< ustar squared at v-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJ_(G)) :: taux_u !< zonal wind stress at u-pts [R L Z T-2 ~> Pa] + real, dimension(SZI_(G),SZJB_(G)) :: tauy_v !< meridional wind stress at v-pts [R L Z T-2 ~> Pa] + real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u !< angle between wind and x-axis at u-pts [rad] + real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v !< angle between wind and y-axis at v-pts [rad] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tau_u !< kinematic zonal mtm flux at u-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tau_v !< kinematic mer. mtm flux at v-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauxDG_u !< downgradient zonal mtm flux at u-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauyDG_u !< downgradient meri mtm flux at u-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauxDG_v !< downgradient zonal mtm flux at v-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tauyDG_v !< downgradient meri mtm flux at v-pts [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2s_u !< angle between mtm flux and vert shear at u-pts [rad] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2s_v !< angle between mtm flux and vert shear at v-pts [rad] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: omega_tau2w_u !< angle between mtm flux and wind at u-pts [rad] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: omega_tau2w_v !< angle between mtm flux and wind at v-pts [rad] + + real :: pi, Cemp_CG, tmp, cos_tmp, sin_tmp, omega_tmp !< constants and dummy variables + real :: du, dv, depth, sigma, Wind_x, Wind_y !< intermediate variables + real :: taux, tauy, tauxDG, tauyDG, tauxDGup, tauyDGup, ustar2, tauh !< intermediate variables + real :: tauNLup, tauNLdn, tauNL_CG, tauNL_DG, tauNL_X, tauNL_Y, tau_MAG !< intermediate variables + real :: omega_w2s, omega_tau2s, omega_s2x, omega_tau2x, omega_tau2w, omega_s2w !< intermediate angles + integer :: kblmin, kbld, kp1, k, nz !< vertical indices + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq ! horizontal indices is = G%isc ; ie = G%iec; js = G%jsc; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke pi = 4. * atan2(1.,1.) Cemp_CG = 3.6 kblmin = 1 - FPdiag_u(:,:,:) = 0.0 - FPdiag_v(:,:,:) = 0.0 taux_u(:,:) = 0. tauy_v(:,:) = 0. @@ -292,7 +285,7 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US depth = 0.0 do k = 1, nz depth = depth + CS%h_u(I,j,k) - if( (depth .ge. hbl_u(I,j)) .and. (kbl_u(I,j) .eq. 0 ) .and. (k > (kblmin-1)) ) then + if( (depth >= hbl_u(I,j)) .and. (kbl_u(I,j) == 0 ) .and. (k > (kblmin-1)) ) then kbl_u(I,j) = k hbl_u(I,j) = depth endif @@ -303,18 +296,18 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US do J = Jsq,Jeq do i = is,ie if( (G%mask2dCv(i,J) > 0.5) ) then - tmp = MAX ( 1.0 ,(G%mask2dT(i,j) + G%mask2dT(i,j+1) ) ) - hbl_v(i,J) = (G%mask2dT(i,j)* hbl_h(i,J) + G%mask2dT(i,j+1) * hbl_h(i,j+1)) /tmp - tmp = MAX(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i,j+1) + G%mask2dCu(i-1,j) + G%mask2dCu(i-1,j+1) ) ) - taux = ( G%mask2dCu(i ,j )*taux_u(i ,j ) + G%mask2dCu(i ,j+1)*taux_u(i ,j+1) & - + G%mask2dCu(i-1,j )*taux_u(i-1,j ) + G%mask2dCu(i-1,j+1)*taux_u(i-1,j+1) ) / tmp - ustar2_v(i,J) = sqrt( tauy_v(i,J)*tauy_v(i,J) + taux*taux ) - omega_w2x_v(i,J) = atan2( tauy_v(i,J) , taux ) + tmp = max( 1.0 ,(G%mask2dT(i,j) + G%mask2dT(i,j+1))) + hbl_v(i,J) = (G%mask2dT(i,j) * hbl_h(i,J) + G%mask2dT(i,j+1) * hbl_h(i,j+1)) /tmp + tmp = max(1.0, (G%mask2dCu(i,j) + G%mask2dCu(i,j+1) + G%mask2dCu(i-1,j) + G%mask2dCu(i-1,j+1))) + taux = ( G%mask2dCu(i ,j) * taux_u(i ,j) + G%mask2dCu(i ,j+1) * taux_u(i ,j+1) & + + G%mask2dCu(i-1,j) * taux_u(i-1,j) + G%mask2dCu(i-1,j+1) * taux_u(i-1,j+1)) / tmp + ustar2_v(i,J) = sqrt(tauy_v(i,J)*tauy_v(i,J) + taux*taux) + omega_w2x_v(i,J) = atan2( tauy_v(i,J), taux ) tauyDG_v(i,J,1) = tauy_v(i,J) depth = 0.0 do k = 1, nz depth = depth + CS%h_v(i,J,k) - if( (depth .ge. hbl_v(i,J)) .and. (kbl_v(i,J) .eq. 0 ) .and. (k > (kblmin-1)) ) then + if( (depth >= hbl_v(i,J)) .and. (kbl_v(i,J) == 0) .and. (k > (kblmin-1))) then kbl_v(i,J) = k hbl_v(i,J) = depth endif @@ -331,7 +324,7 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US ! Compute downgradient stresses do k = 1, nz - kp1 = MIN( k+1 , nz) + kp1 = min( k+1 , nz) do j = js ,je do I = Isq , Ieq tauxDG_u(I,j,k+1) = CS%a_u(I,j,kp1) * (ui(I,j,k) - ui(I,j,kp1)) @@ -376,7 +369,7 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US tau_u(:,:,:) = 0.0 tau_v(:,:,:) = 0.0 - !w Default implicit (I) stress magnitude tau_[uv] & direction Omega_tau2(w,s,x)_[uv] Profiles + ! stress magnitude tau_[uv] & direction Omega_tau2(w,s,x)_[uv] do j = js,je do I = Isq,Ieq if( (G%mask2dCu(I,j) > 0.5) ) then @@ -386,7 +379,6 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US Omega_tau2w_u(I,j,1) = 0.0 Omega_tau2s_u(I,j,1) = 0.0 - ! WGL; TODO: can we use set_v_at_u to get tauyDG_u? do k=1,nz kp1 = MIN(k+1 , nz) tau_u(I,j,k+1) = sqrt( tauxDG_u(I,j,k+1)*tauxDG_u(I,j,k+1) + tauyDG_u(I,j,k+1)*tauyDG_u(I,j,k+1)) @@ -409,7 +401,6 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US Omega_tau2w_v(i,J,1) = 0.0 Omega_tau2s_v(i,J,1) = 0.0 - ! WGL; TODO: can we use set_u_at_v to get tauxDG_v? do k=1,nz-1 kp1 = MIN(k+1 , nz) tau_v(i,J,k+1) = sqrt ( tauxDG_v(i,J,k+1)*tauxDG_v(i,J,k+1) + tauyDG_v(i,J,k+1)*tauyDG_v(i,J,k+1) ) @@ -429,9 +420,8 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US do j = js,je do I = Isq,Ieq if( (G%mask2dCu(I,j) > 0.5) ) then - kbld = MIN( (kbl_u(I,j)) , (nz-2) ) + kbld = min( (kbl_u(I,j)) , (nz-2) ) if ( tau_u(I,j,kbld+2) > tau_u(I,j,kbld+1) ) kbld = kbld + 1 - !w if ( tau_u(I,j,kbld+2) > tau_u(I,j,kbld+1) ) kbld = kbld + 1 tauh = tau_u(I,j,kbld+1) + GV%H_subroundoff ! surface boundary conditions @@ -439,7 +429,7 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US tauNLup = 0.0 do k=1, kbld depth = depth + CS%h_u(I,j,k) - sigma = MIN ( 1.0 , depth / hbl_u(i,j) ) + sigma = min( 1.0 , depth / hbl_u(i,j) ) ! linear stress mag tau_MAG = (ustar2_u(I,j) * (1.-sigma) ) + (tauh * sigma ) @@ -449,32 +439,31 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US ! rotate to wind coordinates Wind_x = ustar2_u(I,j) * cos(omega_w2x_u(I,j)) Wind_y = ustar2_u(I,j) * sin(omega_w2x_u(I,j)) - tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) - tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) - omega_w2s = atan2( tauNL_CG , tauNL_DG ) + tauNL_DG = (Wind_x * cos_tmp + Wind_y * sin_tmp) + tauNL_CG = (Wind_y * cos_tmp - Wind_x * sin_tmp) + omega_w2s = atan2(tauNL_CG, tauNL_DG) omega_s2w = 0.0-omega_w2s tauNL_CG = Cemp_CG * G_sig(sigma) * tauNL_CG - tau_MAG = MAX( tau_MAG , tauNL_CG ) - tauNL_DG = sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) - tau_u(I,j,k+1) + tau_MAG = max(tau_MAG, tauNL_CG) + tauNL_DG = sqrt(tau_MAG*tau_MAG - tauNL_CG*tauNL_CG) - tau_u(I,j,k+1) ! back to x,y coordinates - tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) - tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) - tauNLdn = tauNL_X + tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp) + tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp) + tauNLdn = tauNL_X ! nonlocal increment and update to uold - du = (tauNLup - tauNLdn) * (dt/CS%h_u(I,j,k) + GV%H_subroundoff) + du = (tauNLup - tauNLdn) * (dt/CS%h_u(I,j,k) + GV%H_subroundoff) ui(I,j,k) = uold(I,j,k) + du uold(I,j,k) = du - tauNLup = tauNLdn + tauNLup = tauNLdn ! diagnostics - FPdiag_u(I,j,k+1) = tauNL_CG / (tau_MAG + GV%H_subroundoff) - Omega_tau2s_u(I,j,k+1) = atan2( tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG) ) - tau_u(I,j,k+1) = sqrt( (tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2 ) - omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y) , (tauxDG_u(I,j,k+1) + tauNL_X) ) + Omega_tau2s_u(I,j,k+1) = atan2(tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG)) + tau_u(I,j,k+1) = sqrt((tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2) + omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y), (tauxDG_u(I,j,k+1) + tauNL_X)) omega_tau2w = omega_tau2x - omega_w2x_u(I,j) - if (omega_tau2w >= pi ) omega_tau2w = omega_tau2w - 2.*pi + if (omega_tau2w >= pi ) omega_tau2w = omega_tau2w - 2.*pi if (omega_tau2w <= (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi Omega_tau2w_u(I,j,k+1) = omega_tau2w enddo @@ -490,8 +479,8 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US do J = Jsq,Jeq do i = is,ie if( (G%mask2dCv(i,J) > 0.5) ) then - kbld = MIN( (kbl_v(i,J)) , (nz-2) ) - if ( tau_v(i,J,kbld+2) > tau_v(i,J,kbld+1) ) kbld = kbld + 1 + kbld = min((kbl_v(i,J)), (nz-2)) + if (tau_v(i,J,kbld+2) > tau_v(i,J,kbld+1)) kbld = kbld + 1 tauh = tau_v(i,J,kbld+1) !surface boundary conditions @@ -499,27 +488,27 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US tauNLup = 0.0 do k=1, kbld depth = depth + CS%h_v(i,J,k) - sigma = MIN ( 1.0 , (depth ) / hbl_v(I,J) ) + sigma = min(1.0, depth/ hbl_v(I,J)) ! linear stress - tau_MAG = (ustar2_v(i,J) * (1.-sigma) ) + (tauh * sigma ) + tau_MAG = (ustar2_v(i,J) * (1.-sigma)) + (tauh * sigma) cos_tmp = tauxDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) sin_tmp = tauyDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff) ! rotate into wind coordinate Wind_x = ustar2_v(i,J) * cos(omega_w2x_v(i,J)) Wind_y = ustar2_v(i,J) * sin(omega_w2x_v(i,J)) - tauNL_DG = ( Wind_x *cos_tmp + Wind_y *sin_tmp ) - tauNL_CG = ( Wind_y *cos_tmp - Wind_x *sin_tmp ) - omega_w2s = atan2( tauNL_CG , tauNL_DG ) + tauNL_DG = (Wind_x * cos_tmp + Wind_y * sin_tmp) + tauNL_CG = (Wind_y * cos_tmp - Wind_x * sin_tmp) + omega_w2s = atan2(tauNL_CG , tauNL_DG) omega_s2w = 0.0 - omega_w2s tauNL_CG = Cemp_CG * G_sig(sigma) * tauNL_CG - tau_MAG = MAX( tau_MAG , tauNL_CG ) - tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt( tau_MAG*tau_MAG - tauNL_CG*tauNL_CG ) + tau_MAG = max( tau_MAG , tauNL_CG ) + tauNL_DG = 0.0 - tau_v(i,J,k+1) + sqrt(tau_MAG*tau_MAG - tauNL_CG*tauNL_CG) ! back to x,y coordinate - tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp ) - tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp ) + tauNL_X = (tauNL_DG * cos_tmp - tauNL_CG * sin_tmp) + tauNL_Y = (tauNL_DG * sin_tmp + tauNL_CG * cos_tmp) tauNLdn = tauNL_Y dv = (tauNLup - tauNLdn) * (dt/(CS%h_v(i,J,k)) ) vi(i,J,k) = vold(i,J,k) + dv @@ -527,12 +516,11 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US tauNLup = tauNLdn ! diagnostics - FPdiag_v(i,j,k+1) = tau_MAG / tau_v(i,J,k+1) - Omega_tau2s_v(i,J,k+1) = atan2( tauNL_CG , tau_v(i,J,k+1) + tauNL_DG ) - tau_v(i,J,k+1) = sqrt( (tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2 ) - omega_tau2x = atan2( (tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X) ) + Omega_tau2s_v(i,J,k+1) = atan2(tauNL_CG, tau_v(i,J,k+1) + tauNL_DG) + tau_v(i,J,k+1) = sqrt((tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2) + omega_tau2x = atan2((tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X)) omega_tau2w = omega_tau2x - omega_w2x_v(i,J) - if (omega_tau2w .gt. pi ) omega_tau2w = omega_tau2w - 2.*pi + if (omega_tau2w > pi) omega_tau2w = omega_tau2w - 2.*pi if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi Omega_tau2w_v(i,J,k+1) = omega_tau2w enddo @@ -549,17 +537,14 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US call uvchksum("FP-tau_[uv] ", tau_u, tau_v, G%HI, haloshift=0, scalar_pair=.true.) endif - ! GMM; TODO: can you make the arrays used below allocatable? if(L_diag) then - if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) - if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) + if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) + if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) if (CS%id_FPtau2s_u > 0) call post_data(CS%id_FPtau2s_u, omega_tau2s_u, CS%diag) if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag) if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag) if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag) - if (CS%id_FPdiag_u > 0) call post_data(CS%id_FPdiag_u, FPdiag_u, CS%diag) - if (CS%id_FPdiag_v > 0) call post_data(CS%id_FPdiag_v, FPdiag_v, CS%diag) - if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag) + if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag) endif end subroutine vertFPmix @@ -576,7 +561,7 @@ real function G_sig(sigma) ! cubic function c2 = 1.74392 c3 = 2.58538 - G_sig = MIN ( p1 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (c2*sigma - c3) ) ) + G_sig = min( p1 * (1.-sigma)*(1.-sigma) , sigma * (1. + sigma * (c2*sigma - c3) ) ) end function G_sig !> Compute coupling coefficient associated with vertical viscosity parameterization as in Greatbatch and Lamb @@ -2875,10 +2860,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_FPw2x = register_diag_field('ocean_model', 'FPw2x', diag%axesT1, Time, & 'Wind direction from x-axis','radians') - CS%id_FPdiag_u = register_diag_field('ocean_model', 'FPdiag_u', diag%axesCui, Time, & - 'FP diagmostic (u-points)','binary') - CS%id_FPdiag_v = register_diag_field('ocean_model', 'FPdiag_v', diag%axesCvi, Time, & - 'FP diagnostic (v-points)','binary') CS%id_tauFP_u = register_diag_field('ocean_model', 'tauFP_u', diag%axesCui, Time, & 'Stress Mag Profile (u-points)', 'm2 s-2') CS%id_tauFP_v = register_diag_field('ocean_model', 'tauFP_v', diag%axesCvi, Time, & From 66fd876af9f702a1fc4f956ca07474613956e447 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 6 Sep 2023 15:29:57 -0600 Subject: [PATCH 209/213] Removed L_diag and moved variables in vertFPmix --- src/core/MOM_dynamics_split_RK2.F90 | 7 +--- .../vertical/MOM_vert_friction.F90 | 41 +++++++++---------- 2 files changed, 22 insertions(+), 26 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 84c84efe39..df28dc0338 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -384,7 +384,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. real :: Idt_bc ! Inverse of the baroclinic timestep [T-1 ~> s-1] - logical :: L_diag ! Controls if diagostics are posted in the vertFPmix logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -696,12 +695,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (CS%fpmix) then - L_diag = .false. hbl(:,:) = 0.0 if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) if (ASSOCIATED(CS%energetic_PBL_CSp)) & call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, m_to_MLD_units=GV%m_to_H) - call vertFPmix(L_diag, up, vp, uold, vold, hbl, h, forces, & + call vertFPmix(up, vp, uold, vold, hbl, h, forces, & dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -947,8 +945,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (CS%fpmix) then - L_diag = .true. - call vertFPmix(L_diag, u, v, uold, vold, hbl, h, forces, dt, & + call vertFPmix(u, v, uold, vold, hbl, h, forces, dt, & G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index aa21f8ab89..1169126c1c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -191,26 +191,26 @@ module MOM_vert_friction contains !> Add nonlocal stress increments to u^n (uold) and v^n (vold) using ui and vi. -subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OBC) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type +subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OBC) + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: ui !< Zonal velocity after vertvisc [L T-1 ~> m s-1] + intent(inout) :: ui !< Zonal velocity after vertvisc [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vi !< Meridional velocity after vertvisc [L T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: uold !< Old Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vold !< Old Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: hbl_h !< boundary layer depth [H ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: hbl_h ! boundary layer depth - logical, intent(in) :: L_diag !< controls if diagnostics should be posted - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [T ~> s] - type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure ! local variables real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u !< boundary layer depth at u-pts [H ~> m] @@ -241,6 +241,7 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US real :: omega_w2s, omega_tau2s, omega_s2x, omega_tau2x, omega_tau2w, omega_s2w !< intermediate angles integer :: kblmin, kbld, kp1, k, nz !< vertical indices integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq ! horizontal indices + is = G%isc ; ie = G%iec; js = G%jsc; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke @@ -321,8 +322,8 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US if (CS%debug) then call uvchksum("surface tau[xy]_[uv] ", taux_u, tauy_v, G%HI, haloshift=1, scalar_pair=.true.) - call uvchksum("ustar2 ",ustar2_u, ustar2_v, G%HI, haloshift=0, scalar_pair=.true.) - call uvchksum(" hbl ", hbl_u , hbl_v , G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum("ustar2", ustar2_u, ustar2_v, G%HI, haloshift=0, scalar_pair=.true.) + call uvchksum(" hbl", hbl_u , hbl_v , G%HI, haloshift=0, scalar_pair=.true.) endif ! Compute downgradient stresses @@ -540,15 +541,13 @@ subroutine vertFPmix(L_diag, ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US call uvchksum("FP-tau_[uv] ", tau_u, tau_v, G%HI, haloshift=0, scalar_pair=.true.) endif - if(L_diag) then - if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) - if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) - if (CS%id_FPtau2s_u > 0) call post_data(CS%id_FPtau2s_u, omega_tau2s_u, CS%diag) - if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag) - if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag) - if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag) - if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag) - endif + if (CS%id_tauFP_u > 0) call post_data(CS%id_tauFP_u, tau_u, CS%diag) + if (CS%id_tauFP_v > 0) call post_data(CS%id_tauFP_v, tau_v, CS%diag) + if (CS%id_FPtau2s_u > 0) call post_data(CS%id_FPtau2s_u, omega_tau2s_u, CS%diag) + if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag) + if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag) + if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag) + if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag) end subroutine vertFPmix From d9aa751a46b67c0d496b9baab28549b2fc679c8f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 6 Sep 2023 16:12:36 -0600 Subject: [PATCH 210/213] Revert order of variables in vertFPmix --- src/parameterizations/vertical/MOM_vert_friction.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 1169126c1c..f513f50158 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -192,7 +192,8 @@ module MOM_vert_friction !> Add nonlocal stress increments to u^n (uold) and v^n (vold) using ui and vi. subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OBC) - + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ui !< Zonal velocity after vertvisc [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -206,11 +207,9 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure + type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure ! local variables real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u !< boundary layer depth at u-pts [H ~> m] From 5bc0c5e077a4e64a66102f33d5eb256bf794c670 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 8 Sep 2023 16:23:39 -0600 Subject: [PATCH 211/213] Pass wavebands from coupler to wave_parameters_CS (#255) * Makes set_u_at_v and set_v_at_u public * First draft for fpmix * Change name of logical Replaces LU_pred to L_diag, since now this logical only controls if diagnostics should be posted. * Updates to vertFPmix This commit adds the latest updates to the vertFPmix subroutine after Bill Large did some cleaning. We have highlight places in the code where work must be done. * Add missing use for vertFPmix * Add omega_w2x to fluxes and forces omega_w2x is the counter-clockwise angle of the wind stress with respect to the horizontal abscissa (x-coordinate) at tracer points [rad]. This variable is needed in the vertPFmix subroutine. * Add mssing call to get_param for FPMIX This line of code was lost during the last merge. * Pass wavebands from coupler to wave_parameters_CS This commit passes the waveband information recieved from the coupler to wave_parameters_CS. This information is set to public so that it can be used elsewhere. To exercise this code the following must be set: SURFBAND = COUPLER WAVE_METHOD = SURFACE_BANDS No answer changes. * Describe local variables and make code consistent * Removed L_diag and moved variables in vertFPmix * Revert order of variables in vertFPmix --- src/user/MOM_wave_interface.F90 | 37 +++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index a548436329..02da5a0007 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -98,6 +98,21 @@ module MOM_wave_interface !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:), public :: & + WaveNum_Cen !< Wavenumber bands for read/coupled [Z-1 ~> m-1] + real, allocatable, dimension(:,:,:), public :: & + UStk_Hb !< Surface Stokes Drift spectrum (zonal) [L T-1 ~> m s-1] + !! Horizontal -> H-points + !! 3rd dimension -> Freq/Wavenumber + real, allocatable, dimension(:,:,:), public :: & + VStk_Hb !< Surface Stokes Drift spectrum (meridional) [L T-1 ~> m s-1] + !! Horizontal -> H-points + !! 3rd dimension -> Freq/Wavenumber + real, allocatable, dimension(:,:), public :: & + Omega_w2x !< wind direction ccw from model x- axis [nondim radians] + integer, public :: NumBands = 0 !< Number of wavenumber/frequency partitions + !! Must match the number of bands provided + !! via either coupling or file. ! The remainder of this control structure is private integer :: WaveMethod = -99 !< Options for including wave information @@ -149,18 +164,12 @@ module MOM_wave_interface real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number [nondim] real :: LA_HBL_min !< Minimum boundary layer depth for averaging Langmuir number [Z ~> m] logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number - - integer :: NumBands = 0 !< Number of wavenumber/frequency partitions to receive - !! This needs to match the number of bands provided - !! via either coupling or file. real :: g_Earth !< The gravitational acceleration, equivalent to GV%g_Earth but with !! different dimensional rescaling appropriate for deep-water gravity !! waves [Z T-2 ~> m s-2] real :: I_g_Earth !< The inverse of the gravitational acceleration, with dimensional rescaling !! appropriate for deep-water gravity waves [T2 Z-1 ~> s2 m-1] ! Surface Wave Dependent 1d/2d/3d vars - real, allocatable, dimension(:) :: & - WaveNum_Cen !< Wavenumber bands for read/coupled [Z-1 ~> m-1] real, allocatable, dimension(:) :: & Freq_Cen !< Central frequency for wave bands, including a factor of 2*pi [T-1 ~> s-1] real, allocatable, dimension(:) :: & @@ -448,6 +457,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar allocate( CS%WaveNum_Cen(CS%NumBands), source=0.0 ) allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NumBands), source=0.0 ) + allocate( CS%UStk_Hb(G%isc:G%iec,G%jsc:G%jec,CS%NumBands), source=0.0 ) + allocate( CS%VStk_Hb(G%isc:G%iec,G%jsc:G%jec,CS%NumBands), source=0.0 ) + allocate( CS%Omega_w2x(G%isc:G%iec,G%jsc:G%jec) , source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -463,6 +475,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar allocate( CS%PrescribedSurfStkY(1:CS%NumBands), source=0.0 ) allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:CS%NumBands), source=0.0 ) allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:CS%NumBands), source=0.0 ) + CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -692,6 +705,15 @@ subroutine Update_Surface_Waves(G, GV, US, Time_present, dt, CS, forces) enddo call pass_vector(CS%STKx0(:,:,b),CS%STKy0(:,:,b), G%Domain) enddo + do jj=G%jsc,G%jec + do ii=G%isc,G%iec + CS%Omega_w2x(ii,jj) = forces%omega_w2x(ii,jj) + do b=1,CS%NumBands + CS%UStk_Hb(ii,jj,b) = US%m_s_to_L_T*forces%UStkb(ii,jj,b) + CS%VStk_Hb(ii,jj,b) = US%m_s_to_L_T*forces%VStkb(ii,jj,b) + enddo + enddo + enddo elseif (CS%DataSource == INPUT) then do b=1,CS%NumBands do jj=G%jsd,G%jed @@ -2009,6 +2031,9 @@ subroutine Waves_end(CS) if (allocated(CS%La_turb)) deallocate( CS%La_turb ) if (allocated(CS%STKx0)) deallocate( CS%STKx0 ) if (allocated(CS%STKy0)) deallocate( CS%STKy0 ) + if (allocated(CS%UStk_Hb)) deallocate( CS%UStk_Hb ) + if (allocated(CS%VStk_Hb)) deallocate( CS%VStk_Hb ) + if (allocated(CS%Omega_w2x)) deallocate( CS%Omega_w2x ) if (allocated(CS%KvS)) deallocate( CS%KvS ) if (allocated(CS%Us0_y)) deallocate( CS%Us0_y ) if (allocated(CS%Us0_x)) deallocate( CS%Us0_x ) From d363034fcc99eef960889b613b4144df8d8eea5a Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Tue, 12 Sep 2023 10:37:27 -0600 Subject: [PATCH 212/213] Deprecate mct cap (#257) * Move mct_cap/ to STALE_mct_cap/. mct cap is no longer supported and will soon be removed for good. * remove mct from CI testing * Remove mct test from github workflows --- .github/workflows/coupled-api.yml | 4 ---- .testing/Makefile | 7 ------- .../{mct_cap => STALE_mct_cap}/mom_ocean_model_mct.F90 | 0 .../{mct_cap => STALE_mct_cap}/mom_surface_forcing_mct.F90 | 0 .../drivers/{mct_cap => STALE_mct_cap}/ocn_cap_methods.F90 | 0 .../drivers/{mct_cap => STALE_mct_cap}/ocn_comp_mct.F90 | 0 .../drivers/{mct_cap => STALE_mct_cap}/ocn_cpl_indices.F90 | 0 7 files changed, 11 deletions(-) rename config_src/drivers/{mct_cap => STALE_mct_cap}/mom_ocean_model_mct.F90 (100%) rename config_src/drivers/{mct_cap => STALE_mct_cap}/mom_surface_forcing_mct.F90 (100%) rename config_src/drivers/{mct_cap => STALE_mct_cap}/ocn_cap_methods.F90 (100%) rename config_src/drivers/{mct_cap => STALE_mct_cap}/ocn_comp_mct.F90 (100%) rename config_src/drivers/{mct_cap => STALE_mct_cap}/ocn_cpl_indices.F90 (100%) diff --git a/.github/workflows/coupled-api.yml b/.github/workflows/coupled-api.yml index 4a07c0b639..2d99b45967 100644 --- a/.github/workflows/coupled-api.yml +++ b/.github/workflows/coupled-api.yml @@ -28,7 +28,3 @@ jobs: - name: Compile MOM6 for the NUOPC driver shell: bash run: make check_mom6_api_nuopc -j - - - name: Compile MOM6 for the MCT driver - shell: bash - run: make check_mom6_api_mct -j diff --git a/.testing/Makefile b/.testing/Makefile index b877ecb5f2..942f44d4c3 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -255,7 +255,6 @@ build/opt/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) build/opt_target/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) -build/mct/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/cov/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) build/unit/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) @@ -269,7 +268,6 @@ build/opt/Makefile: MOM_ACFLAGS= build/opt_target/Makefile: MOM_ACFLAGS= build/coupled/Makefile: MOM_ACFLAGS=--with-driver=FMS_cap build/nuopc/Makefile: MOM_ACFLAGS=--with-driver=nuopc_cap -build/mct/Makefile: MOM_ACFLAGS=--with-driver=mct_cap build/cov/Makefile: MOM_ACFLAGS= build/unit/Makefile: MOM_ACFLAGS=--with-driver=unit_tests @@ -370,11 +368,6 @@ build/coupled/ocean_model_MOM.o: build/coupled/Makefile cd $(@D) && make $(@F) check_mom6_api_coupled: build/coupled/ocean_model_MOM.o -# MCT driver -build/mct/mom_ocean_model_mct.o: build/mct/Makefile - cd $(@D) && make $(@F) -check_mom6_api_mct: build/mct/mom_ocean_model_mct.o - #--- # Testing diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 similarity index 100% rename from config_src/drivers/mct_cap/mom_ocean_model_mct.F90 rename to config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 similarity index 100% rename from config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 rename to config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 diff --git a/config_src/drivers/mct_cap/ocn_cap_methods.F90 b/config_src/drivers/STALE_mct_cap/ocn_cap_methods.F90 similarity index 100% rename from config_src/drivers/mct_cap/ocn_cap_methods.F90 rename to config_src/drivers/STALE_mct_cap/ocn_cap_methods.F90 diff --git a/config_src/drivers/mct_cap/ocn_comp_mct.F90 b/config_src/drivers/STALE_mct_cap/ocn_comp_mct.F90 similarity index 100% rename from config_src/drivers/mct_cap/ocn_comp_mct.F90 rename to config_src/drivers/STALE_mct_cap/ocn_comp_mct.F90 diff --git a/config_src/drivers/mct_cap/ocn_cpl_indices.F90 b/config_src/drivers/STALE_mct_cap/ocn_cpl_indices.F90 similarity index 100% rename from config_src/drivers/mct_cap/ocn_cpl_indices.F90 rename to config_src/drivers/STALE_mct_cap/ocn_cpl_indices.F90 From dcaadf71d0680e41d23f41db29b3cef0b4a96ea8 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Mon, 6 Nov 2023 14:10:11 -0700 Subject: [PATCH 213/213] set %label in register_netcdf_field and register_netcdf_axis (#262) --- src/framework/MOM_netcdf.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_netcdf.F90 b/src/framework/MOM_netcdf.F90 index 95e6aa7bb7..73f276aba9 100644 --- a/src/framework/MOM_netcdf.F90 +++ b/src/framework/MOM_netcdf.F90 @@ -217,6 +217,8 @@ function register_netcdf_field(handle, label, axes, longname, units) & allocate(dimids(size(axes))) dimids(:) = [(axes(i)%dimid, i = 1, size(axes))] + field%label = label + ! Determine the corresponding netCDF data type ! TODO: Support a `pack`-like argument select case (kind(1.0)) @@ -225,7 +227,7 @@ function register_netcdf_field(handle, label, axes, longname, units) & case (real64) xtype = NF90_DOUBLE case default - call MOM_error(FATAL, "register_netcdf_axis: Unknown kind(real).") + call MOM_error(FATAL, "register_netcdf_field: Unknown kind(real).") end select ! Register the field variable @@ -293,6 +295,8 @@ function register_netcdf_axis(handle, label, units, longname, points, & "Axis must either have explicit points or be a time axis ('T').") endif + axis%label = label + if (present(points)) then axis_size = size(points) allocate(axis%points(axis_size))