From ca61bf94763e2a7b3bfa6f195b67ca6d2e83d230 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 24 Sep 2021 17:10:01 -0400 Subject: [PATCH 01/29] Horizontal viscosity pointer removal * Change `hor_visc_CS` pointers to locals --- src/core/MOM_dynamics_split_RK2.F90 | 10 ++-- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- .../lateral/MOM_hor_visc.F90 | 55 ++++++------------- 4 files changed, 29 insertions(+), 48 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index cee024dff0..c045ce24c1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -199,7 +199,7 @@ module MOM_dynamics_split_RK2 ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure @@ -724,7 +724,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & + MEKE, Varmix, G, GV, US, CS%hor_visc, & OBC=CS%OBC, BT=CS%barotropic_CSp, TD=thickness_diffuse_CSp, & ADp=CS%ADp) call cpu_clock_end(id_clock_horvisc) @@ -1394,7 +1394,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE, ADp=CS%ADp) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -1438,7 +1438,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) then call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp, & + G, GV, US, CS%hor_visc, & OBC=CS%OBC, BT=CS%barotropic_CSp, & TD=thickness_diffuse_CSp) else @@ -1696,7 +1696,7 @@ subroutine end_dyn_split_RK2(CS) call vertvisc_end(CS%vertvisc_CSp) deallocate(CS%vertvisc_CSp) - call hor_visc_end(CS%hor_visc_CSp) + call hor_visc_end(CS%hor_visc) call PressureForce_end(CS%PressureForce_CSp) deallocate(CS%PressureForce_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 48d767e1a8..c751c19921 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -144,7 +144,7 @@ module MOM_dynamics_unsplit ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure @@ -258,7 +258,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! diffu = horizontal viscosity terms (u,h) call enable_averages(dt, Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, G, GV, US, CS%hor_visc_CSp) + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, G, GV, US, CS%hor_visc) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -658,7 +658,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e6fec7f61e..563e9723da 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -146,7 +146,7 @@ module MOM_dynamics_unsplit_RK2 ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure @@ -269,7 +269,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averages(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) @@ -620,7 +620,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index db2514576d..0b733514a7 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -177,8 +177,8 @@ module MOM_hor_visc type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics - ! real, pointer :: hf_diffu(:,:,:) => NULL() ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, pointer :: hf_diffv(:,:,:) => NULL() ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! 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]. ! 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. @@ -238,14 +238,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(hor_visc_CS), pointer :: CS !< Control structure returned by a previous - !! call to hor_visc_init. + type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type - type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing - !! barotropic velocities. - type(thickness_diffuse_CS), optional, pointer :: TD !< Pointer to a structure containing - !! thickness diffusivities. - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers + type(barotropic_CS), intent(in), optional :: BT !< Barotropic control struct + type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control struct + type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -419,8 +416,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, apply_OBC = .true. endif ; endif ; endif - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_hor_visc: Module must be initialized before it is used.") if (.not.(CS%Laplacian .or. CS%biharmonic)) return find_FrictWork = (CS%id_FrictWork > 0) @@ -1457,11 +1452,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! Applying GME diagonal term. This is linear and the arguments can be rescaled. - !### This smoothing is only applied at computational grid points, but is used in extra halo points! - !### There are blocking halo updates in the smooth_GME routines, which could be avoided by expanding - ! the loop ranges by a point in the code setting str_xx_GME and str_xy_GME a few lines above. - call smooth_GME(CS, G, GME_flux_h=str_xx_GME) - call smooth_GME(CS, G, GME_flux_q=str_xy_GME) + call smooth_GME(G, GME_flux_h=str_xx_GME) + call smooth_GME(G, GME_flux_q=str_xy_GME) 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)) @@ -1756,13 +1748,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) deallocate(diffv_visc_rem) endif - end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) +subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) type(time_type), intent(in) :: Time !< Current model 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 @@ -1770,10 +1761,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, 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), pointer :: CS !< Pointer to the control structure for this module - type(MEKE_type), pointer :: MEKE !< MEKE data - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers - ! Local variables + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + 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 @@ -1830,12 +1820,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "hor_visc_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) + CS%diag => diag ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -2455,7 +2440,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! 'Fractional Thickness-weighted Zonal Acceleration from Horizontal Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if ((CS%id_hf_diffu > 0) .and. (present(ADp))) then - ! call safe_alloc_ptr(CS%hf_diffu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) + ! call safe_alloc_alloc(CS%hf_diffu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) ! call safe_alloc_ptr(ADp%diag_hfrac_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) !endif @@ -2463,7 +2448,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! 'Fractional Thickness-weighted Meridional Acceleration from Horizontal Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if ((CS%id_hf_diffv > 0) .and. (present(ADp))) then - ! call safe_alloc_ptr(CS%hf_diffv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) + ! call safe_alloc_alloc(CS%hf_diffv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) ! call safe_alloc_ptr(ADp%diag_hfrac_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) !endif @@ -2587,7 +2572,7 @@ end subroutine hor_visc_init !> Calculates factors in the anisotropic orientation tensor to be align with the grid. !! With n1=1 and n2=0, this recovers the approach of Large et al, 2001. subroutine align_aniso_tensor_to_grid(CS, n1, n2) - type(hor_visc_CS), pointer :: CS !< Control structure for horizontal viscosity + type(hor_visc_CS), intent(inout) :: CS !< Control structure for horizontal viscosity real, intent(in) :: n1 !< i-component of direction vector [nondim] real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables @@ -2603,9 +2588,7 @@ end subroutine align_aniso_tensor_to_grid !> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any !! horizontal two-grid-point noise -subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) - ! Arguments - type(hor_visc_CS), pointer :: CS !< Control structure +subroutine smooth_GME(G, GME_flux_h, GME_flux_q) 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 @@ -2672,8 +2655,7 @@ end subroutine smooth_GME !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) - type(hor_visc_CS), pointer :: CS !< The control structure returned by a - !! previous call to hor_visc_init. + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct 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) @@ -2716,7 +2698,6 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%n1n1_m_n2n2_h) DEALLOC_(CS%n1n1_m_n2n2_q) endif - deallocate(CS) end subroutine hor_visc_end !> \namespace mom_hor_visc !! From 0e1910327aaad006ec31abae02278b72aec7f09f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 30 Sep 2021 16:57:35 -0400 Subject: [PATCH 02/29] MEKE pointer cleanup * equilibrium_value removed from CS and is now local * MEKE_CS function arguments to stack --- src/core/MOM.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 46 ++++++++++------------ 2 files changed, 21 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 112613dc88..1fe748834d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -356,7 +356,7 @@ module MOM !< Pointer to the control structure used to set viscosities type(diabatic_CS), pointer :: diabatic_CSp => NULL() !< Pointer to the control structure for the diabatic driver - type(MEKE_CS), pointer :: MEKE_CSp => NULL() + type(MEKE_CS) :: MEKE_CSp !< Pointer to the control structure for the MEKE updates type(VarMix_CS), pointer :: VarMix => NULL() !< Pointer to the control structure for the variable mixing module @@ -3626,8 +3626,6 @@ subroutine MOM_end(CS) if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) - if (associated(CS%MEKE_CSp)) deallocate(CS%MEKE_CSp) - if (associated(CS%MEKE)) then call MEKE_end(CS%MEKE) deallocate(CS%MEKE) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 588fa4c75e..5b58280277 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -30,8 +30,6 @@ module MOM_MEKE !> Control structure that contains MEKE parameters and diagnostics handles type, public :: MEKE_CS ; private ! Parameters - real, dimension(:,:), pointer :: equilibrium_value => NULL() !< The equilbrium value - !! of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] @@ -123,7 +121,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + 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] @@ -141,7 +139,9 @@ 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 diagnostic computation + equilibrium_value ! The equilbrium value of MEKE to be calculated at each + ! time step [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G)) :: & MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. @@ -175,8 +175,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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 (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_MEKE: Module must be initialized before it is used.") if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") @@ -355,9 +353,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif if (CS%MEKE_equilibrium_restoring) then - call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) + call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & + equilibrium_value) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - CS%equilibrium_value(i,j)) + src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - equilibrium_value(i,j)) enddo ; enddo endif @@ -674,7 +673,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m 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(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. @@ -835,13 +834,16 @@ end subroutine MEKE_equilibrium !< This subroutine calculates a new equilibrium value for MEKE at each time step. This is not copied into !! MEKE%MEKE; rather, it is used as a restoring term to nudge MEKE%MEKE back to an equilibrium value -subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) +subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & + equilibrium_value) type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: equilibrium_value + !< Equilbrium value of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] ! Local variables real :: SN ! The local Eady growth rate [T-1 ~> s-1] @@ -850,20 +852,17 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec cd2 = CS%cdrag**2 - - if (.not. associated(CS%equilibrium_value)) allocate(CS%equilibrium_value(SZI_(G),SZJ_(G))) - CS%equilibrium_value(:,:) = 0.0 + equilibrium_value(:,:) = 0.0 !$OMP do do j=js,je ; do i=is,ie ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - CS%equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 + equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 enddo ; enddo - if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, CS%equilibrium_value, CS%diag) - + if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, equilibrium_value, CS%diag) end subroutine MEKE_equilibrium_restoring !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ @@ -871,8 +870,8 @@ end subroutine MEKE_equilibrium_restoring !! column eddy energy, respectively. See \ref section_MEKE_equations. subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & bottomFac2, barotrFac2, LmixScale) - type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. + type(MEKE_type), intent(in) :: MEKE !< MEKE data. 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 @@ -946,7 +945,7 @@ end subroutine MEKE_lengthScales !! 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, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: area !< Grid cell area [L2 ~> m2] real, intent(in) :: beta !< Planetary beta = \f$ \nabla f\f$ [T-1 L-1 ~> s-1 m-1] @@ -1023,7 +1022,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) 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(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE-related fields. type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. @@ -1058,11 +1057,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "MEKE-type structure.") return endif - if (associated(CS)) then - call MOM_error(WARNING, & - "MEKE_init called with an associated control structure.") - return - else ; allocate(CS) ; endif call MOM_mesg("MEKE_init: reading parameters ", 5) From 899bf4ee93693b918822ff298ea9dd2e5f1854e5 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 5 Oct 2021 12:31:37 -0400 Subject: [PATCH 03/29] Mixed layer pointer purge * `mixedlayer_restrat_CS` pointers changed to locals MLD_filtered[_slow] pointed moved to allocatables * MLD argument for `mixedlayer_restrat` Restore MLD pointer Passing an uninitialized array is problematic, though passing a pointer to an uninitialized array is not. This can be addressed when vertvisc_type is resolved. --- src/core/MOM.F90 | 5 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 34 +++++-------------- 2 files changed, 10 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1fe748834d..edaab389bc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -350,7 +350,7 @@ module MOM type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() !< Pointer to the control structure used for the isopycnal height diffusive transport. !! This is also common referred to as Gent-McWilliams diffusion - type(mixedlayer_restrat_CS), pointer :: mixedlayer_restrat_CSp => NULL() + type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp !< Pointer to the control structure used for the mixed layer restratification type(set_visc_CS), pointer :: set_visc_CSp => NULL() !< Pointer to the control structure used to set viscosities @@ -3620,9 +3620,6 @@ subroutine MOM_end(CS) deallocate(CS%VarMix) endif - if (associated(CS%mixedlayer_restrat_CSp)) & - deallocate(CS%mixedlayer_restrat_CSp) - if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0d2062441e..7d84120f9c 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -60,9 +60,9 @@ module MOM_mixed_layer_restrat type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - real, dimension(:,:), pointer :: & - MLD_filtered => NULL(), & !< Time-filtered MLD [H ~> m or kg m-2] - MLD_filtered_slow => NULL() !< Slower time-filtered MLD [H ~> m or kg m-2] + 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] !>@{ !! Diagnostic identifier @@ -102,10 +102,7 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Module must be initialized before it is used.") + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure if (GV%nkml>0) then call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) @@ -132,7 +129,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module 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] @@ -236,8 +233,6 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo enddo ! j-loop elseif (CS%MLE_use_PBL_MLD) then - if (.not. associated(MLD_in)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Argument MLD_in was not associated!") do j = js-1, je+1 ; do i = is-1, ie+1 MLD_fast(i,j) = (CS%MLE_MLD_stretch * GV%Z_to_H) * MLD_in(i,j) enddo ; enddo @@ -571,7 +566,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) 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] - type(mixedlayer_restrat_CS), pointer :: CS !< Module 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] @@ -614,8 +609,6 @@ 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. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Module must be initialized before it is used.") if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 @@ -800,7 +793,7 @@ logical function mixedlayer_restrat_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 !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables @@ -822,10 +815,6 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "BULKMIXEDLAYER is true.", default=.false.) if (.not. mixedlayer_restrat_init) return - if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") - endif - ! Nonsense values to cause problems when these parameters are not used CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9*US%kg_m3_to_R @@ -940,7 +929,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, endif ! If MLD_filtered is being used, we need to update halo regions after a restart - if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) + if (allocated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) end function mixedlayer_restrat_init @@ -949,7 +938,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables type(vardesc) :: vd @@ -960,11 +949,6 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) default=.false., do_not_log=.true.) if (.not. mixedlayer_restrat_init) return - ! Allocate the control structure. CS will be later populated by mixedlayer_restrat_init() - if (associated(CS)) call MOM_error(FATAL, & - "mixedlayer_restrat_register_restarts called with an associated control structure.") - allocate(CS) - call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & default=0., do_not_log=.true.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & From 9bf87154483d831afee41f744171e74c84198f74 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 5 Oct 2021 15:26:35 -0400 Subject: [PATCH 04/29] Thickness diffusion pointer removal * `thickness_diffusion_CSp` is moved to local where possible * All arrays and most other pointer content is moved to either allocatable or local to the type. --- src/core/MOM.F90 | 3 +- src/core/MOM_dynamics_split_RK2.F90 | 6 +-- src/core/MOM_dynamics_unsplit.F90 | 1 - src/core/MOM_dynamics_unsplit_RK2.F90 | 1 - .../lateral/MOM_thickness_diffuse.F90 | 49 +++++++++---------- 5 files changed, 25 insertions(+), 35 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index edaab389bc..98e94c0592 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -347,7 +347,7 @@ module MOM !< Pointer to the control structure used for the unsplit RK2 dynamics type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL() !< Pointer to the control structure used for the mode-split RK2 dynamics - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() + type(thickness_diffuse_CS) :: thickness_diffuse_CSp !< Pointer to the control structure used for the isopycnal height diffusive transport. !! This is also common referred to as Gent-McWilliams diffusion type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp @@ -3613,7 +3613,6 @@ subroutine MOM_end(CS) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - deallocate(CS%thickness_diffuse_CSp) if (associated(CS%VarMix)) then call VarMix_end(CS%VarMix) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c045ce24c1..42dedf5a2e 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -209,8 +209,6 @@ module MOM_dynamics_split_RK2 !> A pointer to the barotropic stepping control structure type(barotropic_CS), pointer :: barotropic_CSp => NULL() !> A pointer to a structure containing interface height diffusivities - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() - !> A pointer to the vertical viscosity control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() @@ -292,7 +290,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to a structure containing + type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -1261,7 +1259,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure + type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index c751c19921..5f525596b5 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -89,7 +89,6 @@ module MOM_dynamics_unsplit use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS -use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 563e9723da..42efec91f9 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -87,7 +87,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS -use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 78425676b1..c68558a647 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -82,13 +82,12 @@ module MOM_thickness_diffuse !! Negative values disable the scheme." [nondim] type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] - real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [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, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] - KH_v_GME => NULL() !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_u_GME(:,:,:) !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_v_GME(:,:,:) !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -119,7 +118,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(MEKE_type), pointer :: MEKE !< MEKE control structure type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G),SZK_(GV)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. @@ -161,9 +160,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave 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. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& - "Module must be initialized before it is used.") - if ((.not.CS%thickness_diffuse) .or. & .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return @@ -579,7 +575,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), pointer :: MEKE !< MEKE control structure - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion 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 @@ -727,7 +723,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = .false. if (associated(MEKE)) find_work = associated(MEKE%GM_src) - find_work = (associated(CS%GMwork) .or. find_work) + find_work = (allocated(CS%GMwork) .or. find_work) if (use_EOS) then halo = 1 ! Default halo to fill is 1 @@ -1411,7 +1407,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Note that the units of Work_v and Work_u are W, while Work_h is 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 (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h + if (allocated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE) .and. .not.CS%GM_src_alt) then ; if (associated(MEKE%GM_src)) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h endif ; endif @@ -1487,7 +1483,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV !! 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), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion 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 @@ -1893,7 +1889,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), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1904,12 +1900,6 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! rotation [nondim]. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. - if (associated(CS)) then - call MOM_error(WARNING, & - "Thickness_diffuse_init called with an associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ! Read all relevant parameters and write them to the model log. @@ -2027,8 +2017,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) default=.false.) if (CS%use_GME_thickness_diffuse) then - call safe_alloc_ptr(CS%KH_u_GME,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) - call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) + allocate(CS%KH_u_GME(G%IsdB:G%IedB, G%jsd:G%jed, GV%ke+1), source=0.) + allocate(CS%KH_v_GME(G%isd:G%ied, G%JsdB:G%JedB, GV%ke+1), source=0.) endif CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & @@ -2047,7 +2037,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2, cmor_field_name='tnkebto', & cmor_long_name='Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection', & cmor_standard_name='tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection') - if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) + if (CS%id_GMwork > 0) & + allocate(CS%GMwork(G%isd:G%ied,G%jsd:G%jed), source=0.) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & 'Parameterized mesoscale eddy advection diffusivity at U-point', & @@ -2074,10 +2065,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim', conversion=US%Z_to_L) - if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) + if (CS%id_slope_x > 0) & + allocate(CS%diagSlopeX(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke+1), source=0.) + CS%id_slope_y = register_diag_field('ocean_model', 'neutral_slope_y', diag%axesCvi, Time, & 'Meridional slope of neutral surface', 'nondim', conversion=US%Z_to_L) - if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) + if (CS%id_slope_y > 0) & + allocate(CS%diagSlopeY(G%isd:G%ied,G%JsdB:G%JedB,GV%ke+1), source=0.) + CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction', & 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -2095,7 +2090,7 @@ end subroutine thickness_diffuse_init !> Copies ubtav and vbtav from private type into arrays subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) - type(thickness_diffuse_CS), pointer :: CS !< Control structure for this module + 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 From c91b464c080cf602c454d1291c656cdc3638d50e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 5 Oct 2021 17:11:05 -0400 Subject: [PATCH 05/29] Tidal forcing CS pointer removal * `tidal_forcing_CS` pointers are removed, and its fields are converted to allocatables. - Note that references are retained in the pressure force and barotropic CS instances, to avoid copies. Still working through that one... --- src/core/MOM_PressureForce.F90 | 2 +- src/core/MOM_PressureForce_FV.F90 | 5 +- src/core/MOM_PressureForce_Montgomery.F90 | 7 +-- src/core/MOM_barotropic.F90 | 6 ++- src/core/MOM_dynamics_split_RK2.F90 | 7 +-- .../lateral/MOM_tidal_forcing.F90 | 52 ++++++++----------- 6 files changed, 35 insertions(+), 44 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index dbc01dcc27..0ac1eb1ae1 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -88,7 +88,7 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_CS), pointer :: CS !< Pressure force control structure - type(tidal_forcing_CS), pointer :: tides_CSp !< Tide control structure + type(tidal_forcing_CS), intent(inout), optional :: tides_CSp !< Tide control structure #include "version_variable.h" character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 3100699e6f..ef5a85697c 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -808,7 +808,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure - type(tidal_forcing_CS), pointer :: tides_CSp !< Tides control structure + type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. @@ -821,7 +821,8 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS else ; allocate(CS) ; endif CS%diag => diag ; CS%Time => Time - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + if (present(tides_CSp)) & + CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_FV" call log_version(param_file, mdl, version, "") diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 27aaf49276..4b98e0f73f 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -824,8 +824,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure - type(tidal_forcing_CS), pointer :: tides_CSp !< Tides control structure + type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure + type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! Local variables logical :: use_temperature, use_EOS @@ -840,7 +840,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ else ; allocate(CS) ; endif CS%diag => diag ; CS%Time => Time - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + if (present(tides_CSp)) & + CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_Mont" call log_version(param_file, mdl, version, "") diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 219d22cc93..cf52bd3a89 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4259,7 +4259,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of !! barotropic flow. - type(tidal_forcing_CS), pointer :: tides_CSp !< A pointer to the control structure of the + type(tidal_forcing_CS), target, optional :: tides_CSp !< A pointer to the control structure of the !! tide module. ! This include declares and sets the variable "version". @@ -4316,7 +4316,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%module_is_initialized = .true. CS%diag => diag ; CS%Time => Time - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + if (present(tides_CSp)) then + CS%tides_CSp => tides_CSp + endif ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "SPLIT", CS%split, default=.true., do_not_log=.true.) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 42dedf5a2e..14741dbbd1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -213,7 +213,7 @@ module MOM_dynamics_split_RK2 !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() !> A pointer to the tidal forcing control structure - type(tidal_forcing_CS), pointer :: tides_CSp => NULL() + type(tidal_forcing_CS) :: tides_CSp !> A pointer to the ALE control structure. type(ALE_CS), pointer :: ALE_CSp => NULL() @@ -1699,10 +1699,7 @@ subroutine end_dyn_split_RK2(CS) call PressureForce_end(CS%PressureForce_CSp) deallocate(CS%PressureForce_CSp) - if (associated(CS%tides_CSp)) then - call tidal_forcing_end(CS%tides_CSp) - deallocate(CS%tides_CSp) - endif + call tidal_forcing_end(CS%tides_CSp) call CoriolisAdv_end(CS%CoriolisAdv_Csp) deallocate(CS%CoriolisAdv_CSp) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 0d92a14d2a..b8d5c44098 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -60,15 +60,15 @@ module MOM_tidal_forcing type(time_type) :: time_ref !< Reference time (t = 0) used to calculate tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Astronomical longitudes used to calculate !! tidal phases at t = 0. - real, pointer, dimension(:,:,:) :: & - sin_struct => NULL(), & !< The sine and cosine based structures that can - cos_struct => NULL(), & !< be associated with the astronomical forcing. - cosphasesal => NULL(), & !< The cosine and sine of the phase of the - sinphasesal => NULL(), & !< self-attraction and loading amphidromes. - ampsal => NULL(), & !< The amplitude of the SAL [m]. - cosphase_prev => NULL(), & !< The cosine and sine of the phase of the - sinphase_prev => NULL(), & !< amphidromes in the previous tidal solutions. - amp_prev => NULL() !< The amplitude of the previous tidal solution [m]. + real, allocatable :: & + sin_struct(:,:,:), & !< The sine and cosine based structures that can + cos_struct(:,:,:), & !< be associated with the astronomical forcing. + cosphasesal(:,:,:), & !< The cosine and sine of the phase of the + sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. + ampsal(:,:,:), & !< The amplitude of the SAL [m]. + cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the + sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. + amp_prev(:,:,:) !< The amplitude of the previous tidal solution [m]. end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -230,8 +230,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) type(time_type), intent(in) :: Time !< The current model time. 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(tidal_forcing_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & phase, & ! The phase of some tidal constituent. @@ -253,12 +253,6 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "tidal_forcing_init called with an associated "// & - "control structure.") - return - endif - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "TIDES", tides, & @@ -266,8 +260,6 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) if (.not.tides) return - allocate(CS) - ! Set up the spatial structure functions for the diurnal, semidiurnal, and ! low-frequency tidal components. allocate(CS%sin_struct(isd:ied,jsd:jed,3), source=0.0) @@ -560,7 +552,7 @@ end subroutine find_in_files !! and loading. subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to tidal_forcing_init. + type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a previous call to tidal_forcing_init. real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with !! the local value of eta [nondim]. @@ -586,7 +578,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height !! anomalies [Z ~> m]. - type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a + type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. real, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. @@ -599,8 +591,6 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) 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 (.not.associated(CS)) return - call cpu_clock_begin(id_clock_tides) if (CS%nc == 0) then @@ -659,16 +649,16 @@ subroutine tidal_forcing_end(CS) type(tidal_forcing_CS), intent(inout) :: CS !< The control structure returned by a previous call !! to tidal_forcing_init; it is deallocated here. - if (associated(CS%sin_struct)) deallocate(CS%sin_struct) - if (associated(CS%cos_struct)) deallocate(CS%cos_struct) + if (allocated(CS%sin_struct)) deallocate(CS%sin_struct) + if (allocated(CS%cos_struct)) deallocate(CS%cos_struct) - if (associated(CS%cosphasesal)) deallocate(CS%cosphasesal) - if (associated(CS%sinphasesal)) deallocate(CS%sinphasesal) - if (associated(CS%ampsal)) deallocate(CS%ampsal) + if (allocated(CS%cosphasesal)) deallocate(CS%cosphasesal) + if (allocated(CS%sinphasesal)) deallocate(CS%sinphasesal) + if (allocated(CS%ampsal)) deallocate(CS%ampsal) - if (associated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) - if (associated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) - if (associated(CS%amp_prev)) deallocate(CS%amp_prev) + if (allocated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) + if (allocated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) + if (allocated(CS%amp_prev)) deallocate(CS%amp_prev) end subroutine tidal_forcing_end !> \namespace tidal_forcing From 4a98271a272e1ffcbceb32b687fb6a37a3ee5f2c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 6 Oct 2021 16:47:31 -0400 Subject: [PATCH 06/29] Internal tide pointer removal * Internal tide CS pointer removal (int_tide_CS) * Diabatic driver's `int_tide_CSp` renamed to `int_tide` I am unsure if the instance of int_tide_CS in the diabatic driver (where it is created) needs to be declared as target. Seems not, but watch this issue. --- .../lateral/MOM_internal_tides.F90 | 70 ++++++------------- .../vertical/MOM_diabatic_driver.F90 | 8 +-- .../vertical/MOM_set_diffusivity.F90 | 7 +- 3 files changed, 30 insertions(+), 55 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 6fbdd30d8f..fd420a261f 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -107,10 +107,10 @@ 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, dimension(:,:,:,:,:), pointer :: En => NULL() + real, allocatable :: En(:,:,:,:,:) !< The internal wave energy density as a function of (i,j,angle,frequency,mode) !! integrated within an angular and frequency band [R Z3 T-2 ~> J m-2] - real, dimension(:,:,:), pointer :: En_restart => NULL() + real, allocatable :: En_restart(:,:,:) !< 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]. @@ -169,8 +169,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), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct real, dimension(SZI_(G),SZJ_(G),CS%nMode), & intent(in) :: cn !< The internal wave speeds of each !! mode [L T-1 ~> m s-1]. @@ -210,7 +209,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(time_type) :: time_end logical:: avg_enabled - if (.not.associated(CS)) return 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 I_rho0 = 1.0 / GV%Rho0 @@ -611,8 +609,7 @@ end subroutine propagate_int_tide !> Checks for energy conservation on computational domain subroutine sum_En(G, CS, En, label) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct 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 @@ -654,8 +651,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), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct 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), & @@ -747,8 +743,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), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct 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]. @@ -1011,8 +1006,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) 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), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1137,8 +1132,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), pointer :: CS !< The control structure returned by a previous - !! call to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables integer :: i, j, k, ish, ieh, jsh, jeh, m @@ -1405,8 +1399,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) !! 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), pointer :: CS !< The control structure returned by a previous call - !! to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1480,8 +1473,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !! 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), pointer :: CS !< The control structure returned by a previous call - !! to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1641,8 +1633,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), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct 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 @@ -1748,8 +1739,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), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct 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 @@ -2089,8 +2079,7 @@ 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), pointer :: CS !< The control structure returned by a -! !! previous call to int_tide_init. +! type(int_tide_CS), intent(in) :: CS !< Internal tide control struct ! type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! ! This subroutine is not currently in use!! @@ -2137,8 +2126,8 @@ 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),pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + ! Local variables real :: Angle_size ! size of wedges, rad real, allocatable :: angles(:) ! orientations of wedge centers, rad @@ -2168,14 +2157,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "internal_tides_init called "//& - "with an associated control structure.") - return - else - allocate(CS) - endif - use_int_tides = .false. call read_param(param_file, "INTERNAL_TIDES", use_int_tides) CS%do_int_tides = use_int_tides @@ -2583,18 +2564,13 @@ 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), pointer :: CS !< A pointer to the control structure returned by a previous - !! call to internal_tides_init, it will be deallocated here. - - if (associated(CS)) then - if (associated(CS%En)) deallocate(CS%En) - if (allocated(CS%frequency)) deallocate(CS%frequency) - 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) - deallocate(CS) - endif - CS => NULL() + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + + if (allocated(CS%En)) deallocate(CS%En) + if (allocated(CS%frequency)) deallocate(CS%frequency) + 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) end subroutine internal_tides_end end module MOM_internal_tides diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d3f92e99cc..d849298cba 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -224,7 +224,6 @@ module MOM_diabatic_driver type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module - type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module @@ -237,6 +236,7 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_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(int_tide_CS) :: int_tide !< Internal tide control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -376,7 +376,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + 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 @@ -3399,11 +3399,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_int_tides) then 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_CSp) + call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide_CSp, & + call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide, & halo_TS=CS%halo_TS_diff, double_diffuse=CS%double_diffuse) if (CS%useKPP .and. (CS%double_diffuse .and. .not.CS%use_CVMix_ddiff)) & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b1a4d1433d..b77cdf747f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1954,9 +1954,8 @@ 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), pointer :: int_tide_CSp !< A pointer to the internal tides control - !! structure - integer, intent(out) :: halo_TS !< The halo size of tracer points that must be + type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control struct + integer, optional, 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 !! of double diffusion is being used. @@ -1990,7 +1989,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed CS%diag => diag - if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp + CS%int_tide_CSp => int_tide_CSp ! These default values always need to be set. CS%BBL_mixing_as_max = .true. From 4b6f45ee8f96d20d3b46582307b1bc7e29b24cea Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 7 Oct 2021 00:27:02 -0400 Subject: [PATCH 07/29] Entrain diffusive pointer removal This removes just about all of the entrain_diffusive pointers (except the diag_ctrl). There is a very minor incongruity with `just_read_params`, which was originally used to deallocate the CS, which might alter some removed `if(associated(CS))` checks. But it seems this is not really a problem, since the calls to entrainment_diffusion() are inside regions unreachable when this flag (from `CS%useALEalgorithm`) is true. --- .../vertical/MOM_diabatic_driver.F90 | 12 +++--- .../vertical/MOM_entrain_diffusive.F90 | 37 ++++--------------- 2 files changed, 12 insertions(+), 37 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d849298cba..ff9f8fb4dc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -30,7 +30,7 @@ module MOM_diabatic_driver use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init -use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS +use MOM_entrain_diffusive, only : entrain_diffusive_CS use MOM_EOS, only : calculate_density, calculate_TFreeze, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module @@ -236,7 +235,8 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_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(int_tide_CS) :: int_tide !< Internal tide control struct + type(int_tide_CS) :: int_tide !< Internal tide control struct + type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -1921,7 +1921,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_entrain) ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -3388,7 +3388,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise it is False. CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv_CSp) - call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive_CSp, & + call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive, & just_read_params=CS%useALEalgorithm) ! initialize the geothermal heating module @@ -3487,8 +3487,6 @@ subroutine diabatic_driver_end(CS) deallocate(CS%geothermal_CSp) endif - call entrain_diffusive_end(CS%entrain_diffusive_CSp) - if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) if (CS%useKPP) then diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 4dc08284af..e279092fef 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -18,7 +18,7 @@ module MOM_entrain_diffusive #include -public entrainment_diffusive, entrain_diffusive_init, entrain_diffusive_end +public entrainment_diffusive, entrain_diffusive_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 @@ -60,7 +60,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. real, intent(in) :: dt !< The time increment [T ~> s]. - type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous + type(entrain_diffusive_CS), intent(in) :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: ea !< The amount of fluid entrained from the layer @@ -207,9 +207,6 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff - if (.not. associated(CS)) call MOM_error(FATAL, & - "MOM_entrain_diffusive: Module must be initialized before it is used.") - if (.not.(present(Kd_Lay) .or. present(Kd_int))) call MOM_error(FATAL, & "MOM_entrain_diffusive: Either Kd_Lay or Kd_int must be present in call.") @@ -1022,7 +1019,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which !! i-points to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< The meridional index upon which to work. real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Ent_bl !< The average entrainment upward and @@ -1440,7 +1437,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & !! uppermost interior layer [H ~> m or kg m-2] integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: i !< The i-index to work on - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: ea_kb !< The entrainment from above by the layer below !! the buffer layer (i.e. layer kb) [H ~> m or kg m-2]. real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination @@ -1582,7 +1579,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & integer, intent(in) :: ie !< The end of the i-index range to work on. logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which !! i-points to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost !! interior layer [H ~> m or kg m-2]. !! The input value is the first guess. @@ -1786,7 +1783,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F !! = ent*ds_kb*I_dSkbp1 found in the range !! min_ent < ent < max_ent [H ~> m or kg m-2]. @@ -2067,8 +2064,7 @@ 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), pointer :: CS !< A pointer that is set to point to the control - !! structure. + type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control struct logical, intent(in) :: just_read_params !< If true, this call will only read !! and log parameters without registering !! any diagnostics @@ -2080,13 +2076,6 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re # include "version_variable.h" character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%diag => diag CS%bulkmixedlayer = (GV%nkml > 0) @@ -2115,20 +2104,8 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re 'Work actually done by diapycnal diffusion across each interface', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) endif - - if (just_read_params) deallocate(CS) - end subroutine entrain_diffusive_init -!> This subroutine cleans up and deallocates any memory associated with the -!! entrain_diffusive module. -subroutine entrain_diffusive_end(CS) - type(entrain_diffusive_CS), pointer :: CS !< A pointer to the control structure for this - !! module that will be deallocated. - if (associated(CS)) deallocate(CS) - -end subroutine entrain_diffusive_end - !> \namespace mom_entrain_diffusive !! !! By Robert Hallberg, September 1997 - July 2000 From 2540b4e615b8577ecc7b9548366329ea82275b28 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 7 Oct 2021 15:42:46 -0400 Subject: [PATCH 08/29] Tidal mixing pointer cleanup * `tidal_mixing_CS` pointers moved to locals * `tidal_mixing_CSp` in diffusivity renamed to `tidal_mixing` * Most of the pointer-declared fields converted to allocatables. * Local `dd` pointers to `CS%dd` removed * Reorder calculate_tidal_mixing (and sub-procedure) args --- .../vertical/MOM_set_diffusivity.F90 | 22 +- .../vertical/MOM_tidal_mixing.F90 | 432 +++++++++--------- 2 files changed, 218 insertions(+), 236 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b77cdf747f..dce302372e 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -161,7 +161,7 @@ module MOM_set_diffusivity type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() !< Control structure for a child module type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() !< Control structure for a child module type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module - type(tidal_mixing_cs), pointer :: tidal_mixing_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs) :: tidal_mixing !< Control structure for a child module !>@{ Diagnostic IDs integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1 @@ -326,7 +326,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! set up arrays for tidal mixing diagnostics if (CS%use_tidal_mixing) & - call setup_tidal_diagnostics(G, GV, CS%tidal_mixing_CSp) + call setup_tidal_diagnostics(G, GV, CS%tidal_mixing) if (CS%useKappaShear) then if (CS%debug) then @@ -493,8 +493,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! Add the Nikurashin and / or tidal bottom-driven mixing if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & - N2_lay, N2_int, Kd_lay_2d, Kd_int_2d, CS%Kd_max, visc%Kv_slow) + call calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, & + maxTKE, G, GV, US, CS%tidal_mixing, & + CS%Kd_max, visc%Kv_slow, Kd_lay_2d, Kd_int_2d) + ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then @@ -609,7 +611,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! tidal mixing if (CS%use_tidal_mixing) & - call post_tidal_diagnostics(G, GV, h, CS%tidal_mixing_CSp) + call post_tidal_diagnostics(G, GV, h, CS%tidal_mixing) if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) @@ -965,7 +967,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) enddo - if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing_CSp) + if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing) do k=nz,2,-1 do_any = .false. @@ -2019,7 +2021,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, & - CS%int_tide_CSp, diag, CS%tidal_mixing_CSp) + CS%int_tide_CSp, diag, CS%tidal_mixing) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& @@ -2296,10 +2298,8 @@ subroutine set_diffusivity_end(CS) call bkgnd_mixing_end(CS%bkgnd_mixing_csp) - if (CS%use_tidal_mixing) then - call tidal_mixing_end(CS%tidal_mixing_CSp) - deallocate(CS%tidal_mixing_CSp) - endif + if (CS%use_tidal_mixing) & + call tidal_mixing_end(CS%tidal_mixing) if (CS%user_change_diff) call user_change_diff_end(CS%user_change_diff_CSp) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 760e9ee8ec..b11bb2d8b2 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -43,30 +43,27 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private - real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] - Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] - Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] - N2_int => NULL(),& !< Bouyancy frequency squared at interfaces [T-2 ~> s-2] - vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition [W m-3] - Schmittner_coeff_3d => NULL() !< The coefficient in the Schmittner et al mixing scheme, in UNITS? - real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, - !! interpolated to model vertical coordinate [W m-3?] - real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. - real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent - !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] - real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] - N2_bot => NULL(),& !< bottom squared buoyancy frequency [T-2 ~> s-2] - N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [T-2 ~> s-2] - Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation [Z ~> m] - Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [Z ~> m] - Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient - + real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] + real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + 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 :: 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, + !! interpolated to model vertical coordinate [W m-3?] + 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 + !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] + real, allocatable :: TKE_itidal_used(:,:) !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] + 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 :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient end type !> Control structure with parameters for the tidal mixing module. @@ -147,22 +144,23 @@ module MOM_tidal_mixing !! recover the remapping answers from 2018. If false, use more !! robust forms of the same remapping expressions. - ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input - !! [R Z3 T-3 ~> W m-2] - real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. - real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [T-1 ~> s-1]. - real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input - real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [Z2 ~> m2]. - real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [Z T-1 ~> m s-1] type(int_tide_CS), pointer :: int_tide_CSp=> NULL() !< Control structure for a child module - real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] - real, allocatable, dimension(:,:) :: 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]. - !! TODO: make this E(x,y) only - real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + + ! Data containers + 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]. + 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]. + real, allocatable :: tideamp(:,:) !< RMS tidal amplitude [Z T-1 ~> m s-1] + 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]. + !! 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?] logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the !! answers from the end of 2018. Otherwise, use updated and more robust @@ -170,7 +168,7 @@ module MOM_tidal_mixing ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing - type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays + type(tidal_mixing_diags) :: dd !< Tidal mixing diagnostic arrays !>@{ Diagnostic identifiers integer :: id_TKE_itidal = -1 @@ -219,7 +217,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(int_tide_CS),target, intent(in) :: int_tide_CSp !< A pointer to the internal tides control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. ! Local variables logical :: use_CVMix_tidal @@ -239,12 +237,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di # include "version_variable.h" character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & - "is already associated.") - return - endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -271,8 +263,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di tidal_mixing_init = int_tide_dissipation if (.not. tidal_mixing_init) return - allocate(CS) - allocate(CS%dd) CS%debug = CS%debug.and.is_root_pe() CS%diag => diag CS%int_tide_CSp => int_tide_CSp @@ -435,10 +425,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & .not. CS%use_CVMix_tidal) then - call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%TKE_itidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 + allocate(CS%Nb(isd:ied,jsd:jed), source=0.) + allocate(CS%h2(isd:ied,jsd:jed), source=0.) + allocate(CS%TKE_itidal(isd:ied,jsd:jed), source=0.) + allocate(CS%mask_itidal(isd:ied,jsd:jed), source=1.) call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& @@ -448,7 +438,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) - call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide + allocate(CS%tideamp(is:ie,js:je), source=CS%utide) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & "A scaling factor for the roughness amplitude with "//& @@ -523,7 +513,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & filename) - call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je) ; CS%TKE_Niku(:,:) = 0.0 + 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 scale=Niku_scale*US%W_m2_to_RZ3_T3) @@ -678,20 +668,20 @@ end function tidal_mixing_init !> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. -subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & - N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) +subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kv, Kd_lay, Kd_int) 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] + integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the !! interfaces [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, @@ -699,25 +689,25 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, - !! [Z2 T-1 ~> m2 s-1]. + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)), & + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)+1), & + optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, + !! [Z2 T-1 ~> m2 s-1]. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) + call calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) else - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & - G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) + call add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kd_lay, Kd_int) endif endif end subroutine calculate_tidal_mixing @@ -725,22 +715,22 @@ end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) - integer, intent(in) :: j !< The j-index to work on +subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) 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 - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy - !! frequency at the interfaces [T-2 ~> s-2]. + type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + integer, intent(in) :: j !< The j-index to work on + real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy + !! frequency at the interfaces [T-2 ~> s-2]. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! 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] @@ -759,10 +749,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv 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) - type(tidal_mixing_diags), pointer :: dd => NULL() is = G%isc ; ie = G%iec - dd => CS%dd select case (CS%CVMix_tidal_scheme) case (SIMMONS) @@ -832,17 +820,17 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv endif ! diagnostics - if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + if (allocated(CS%dd%Kd_itidal)) then + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif - if (associated(dd%N2_int)) then - dd%N2_int(i,j,:) = N2_int(i,:) + if (allocated(CS%dd%N2_int)) then + CS%dd%N2_int(i,j,:) = N2_int(i,:) endif - if (associated(dd%Simmons_coeff_2d)) then - dd%Simmons_coeff_2d(i,j) = Simmons_coeff + if (allocated(CS%dd%Simmons_coeff_2d)) then + CS%dd%Simmons_coeff_2d(i,j) = Simmons_coeff endif - if (associated(dd%vert_dep_3d)) then - dd%vert_dep_3d(i,j,:) = vert_dep(:) + if (allocated(CS%dd%vert_dep_3d)) then + CS%dd%vert_dep_3d(i,j,:) = vert_dep(:) endif enddo ! i=is,ie @@ -933,20 +921,20 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv endif ! diagnostics - if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + if (allocated(CS%dd%Kd_itidal)) then + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif - if (associated(dd%N2_int)) then - dd%N2_int(i,j,:) = N2_int(i,:) + if (allocated(CS%dd%N2_int)) then + CS%dd%N2_int(i,j,:) = N2_int(i,:) endif - if (associated(dd%Schmittner_coeff_3d)) then - dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) + if (allocated(CS%dd%Schmittner_coeff_3d)) then + CS%dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) endif - if (associated(dd%tidal_qe_md)) then - dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) + if (allocated(CS%dd%tidal_qe_md)) then + CS%dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) endif - if (associated(dd%vert_dep_3d)) then - dd%vert_dep_3d(i,j,:) = vert_dep(:) + if (allocated(CS%dd%vert_dep_3d)) then + CS%dd%vert_dep_3d(i,j,:) = vert_dep(:) endif enddo ! i=is,ie @@ -966,18 +954,18 @@ end subroutine calculate_CVMix_tidal !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). -subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & - N2_lay, Kd_lay, Kd_int, Kd_max) +subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kd_lay, Kd_int) 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] + integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, @@ -985,16 +973,16 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module + real, intent(in) :: Kd_max !< The maximum increment for diapycnal + !! diffusivity due to TKE-based processes + !! [Z2 T-1 ~> m2 s-1]. + !! Set this to a negative value to have no limit. real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces !! [Z2 T-1 ~> m2 s-1]. - real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes - !! [Z2 T-1 ~> m2 s-1]. - !! Set this to a negative value to have no limit. ! local @@ -1041,10 +1029,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, character(len=160) :: mesg ! The text of an error message integer :: i, k, is, ie, nz integer :: a, fr, m - type(tidal_mixing_diags), pointer :: dd => NULL() is = G%isc ; ie = G%iec ; nz = GV%ke - dd => CS%dd if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return @@ -1070,7 +1056,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, GV%H_subroundoff*GV%H_to_Z) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) + if (allocated(CS%dd%N2_bot)) & + CS%dd%N2_bot(i,j) = N2_bot(i) if ( CS%Int_tide_dissipation ) then if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) @@ -1099,7 +1086,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) - if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) + if (allocated(CS%dd%N2_meanz)) & + CS%dd%N2_meanz(i,j) = N2_meanz(i) enddo ! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling @@ -1150,11 +1138,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, endif endif - if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = z0_polzin(i) - if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) + if (allocated(CS%dd%Polzin_decay_scale)) & + CS%dd%Polzin_decay_scale(i,j) = z0_polzin(i) + if (allocated(CS%dd%Polzin_decay_scale_scaled)) & + CS%dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + if (allocated(CS%dd%N2_bot)) & + CS%dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if (CS%answers_2018) then ! These expressions use dimensional constants to avoid NaN values. @@ -1206,8 +1195,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ! Dissipation of locally trapped internal tide (non-propagating high modes) TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) - if (associated(dd%TKE_itidal_used)) & - dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) + if (allocated(CS%dd%TKE_itidal_used)) & + CS%dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) ! Dissipation of locally trapped lee waves TKE_Niku_bot(i) = 0.0 @@ -1227,7 +1216,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_Niku_rem(i) = Inv_int_lee(i) * TKE_Niku_bot(i) TKE_lowmode_rem(i) = Inv_int_low(i) * TKE_lowmode_bot(i) - if (associated(dd%Fl_itidal)) dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM + if (allocated(CS%dd%Fl_itidal)) & + CS%dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM enddo ! Estimate the work that would be done by mixing in each layer. @@ -1275,42 +1265,43 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, endif ! diagnostics - if (associated(dd%Kd_itidal)) then - ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay + if (allocated(CS%dd%Kd_itidal)) then + ! If at layers, CS%dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_itidal(i,j,K) = CS%dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_Niku(i,j,K) = CS%dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_lowmode(i,j,K) = CS%dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_itidal(i,j,K) = CS%dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_Niku(i,j,K) = CS%dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_lowmode(i,j,K) = CS%dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k NULL() isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = GV%ke - dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) & - allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) & - allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Fl_itidal > 0) allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Fl_lowmode > 0) allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Polzin_decay_scale > 0) allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) - if (CS%id_N2_bot > 0) allocate(dd%N2_bot(isd:ied,jsd:jed), source=0.0) - if (CS%id_N2_meanz > 0) allocate(dd%N2_meanz(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_itidal > 0) allocate(CS%dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_lowmode > 0) allocate(CS%dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Polzin_decay_scale > 0) allocate(CS%dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_bot > 0) allocate(CS%dd%N2_bot(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_meanz > 0) allocate(CS%dd%N2_meanz(isd:ied,jsd:jed), source=0.0) if (CS%id_Polzin_decay_scale_scaled > 0) & - allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) & - allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Kd_Niku_work > 0) allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_Kd_Itidal_work > 0) allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_Kd_Lowmode_Work > 0) allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_TKE_itidal > 0) allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) + allocate(CS%dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_Niku_work > 0) allocate(CS%dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Itidal_work > 0) allocate(CS%dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Lowmode_Work > 0) allocate(CS%dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_itidal > 0) allocate(CS%dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) ! additional diags for CVMix - if (CS%id_N2_int > 0) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_N2_int > 0) allocate(CS%dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif - allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) endif - if (CS%id_vert_dep > 0) allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_vert_dep > 0) allocate(CS%dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) endif end subroutine setup_tidal_diagnostics @@ -1474,63 +1463,57 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) 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]. - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - - ! local - type(tidal_mixing_diags), pointer :: dd => NULL() - - dd => CS%dd + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then - if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, dd%TKE_itidal_used, CS%diag) + if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, CS%dd%TKE_itidal_used, CS%diag) if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, CS%TKE_Niku, CS%diag) if (CS%id_Nb > 0) call post_data(CS%id_Nb, CS%Nb, CS%diag) - if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, dd%N2_bot, CS%diag) - if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,dd%N2_meanz,CS%diag) + if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, CS%dd%N2_bot, CS%diag) + if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,CS%dd%N2_meanz,CS%diag) - if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, dd%Fl_itidal, CS%diag) - if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, dd%Kd_itidal, CS%diag) - if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, dd%Kd_Niku, CS%diag) - if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, dd%Kd_lowmode, CS%diag) - if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, dd%Fl_lowmode, CS%diag) + if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, CS%dd%Fl_itidal, CS%diag) + if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, CS%dd%Kd_itidal, CS%diag) + if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, CS%dd%Kd_Niku, CS%diag) + if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, CS%dd%Kd_lowmode, CS%diag) + if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, CS%dd%Fl_lowmode, CS%diag) - if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, dd%N2_int, CS%diag) - if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) - if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) - if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) - if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, dd%tidal_qe_md, CS%diag) + if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, CS%dd%N2_int, CS%diag) + if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, CS%dd%vert_dep_3d, CS%diag) + if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, CS%dd%Simmons_coeff_2d, CS%diag) + if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, CS%dd%Schmittner_coeff_3d, CS%diag) + if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, CS%dd%tidal_qe_md, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & - call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) - if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, dd%Kd_Niku_Work, CS%diag) + call post_data(CS%id_Kd_Itidal_Work, CS%dd%Kd_Itidal_Work, CS%diag) + if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, CS%dd%Kd_Niku_Work, CS%diag) if (CS%id_Kd_Lowmode_Work > 0) & - call post_data(CS%id_Kd_Lowmode_Work, dd%Kd_Lowmode_Work, CS%diag) + call post_data(CS%id_Kd_Lowmode_Work, CS%dd%Kd_Lowmode_Work, CS%diag) if (CS%id_Polzin_decay_scale > 0 ) & - call post_data(CS%id_Polzin_decay_scale, dd%Polzin_decay_scale, CS%diag) + call post_data(CS%id_Polzin_decay_scale, CS%dd%Polzin_decay_scale, CS%diag) if (CS%id_Polzin_decay_scale_scaled > 0 ) & - call post_data(CS%id_Polzin_decay_scale_scaled, dd%Polzin_decay_scale_scaled, CS%diag) + call post_data(CS%id_Polzin_decay_scale_scaled, CS%dd%Polzin_decay_scale_scaled, CS%diag) endif - if (associated(dd%Kd_itidal)) deallocate(dd%Kd_itidal) - if (associated(dd%Kd_lowmode)) deallocate(dd%Kd_lowmode) - if (associated(dd%Fl_itidal)) deallocate(dd%Fl_itidal) - if (associated(dd%Fl_lowmode)) deallocate(dd%Fl_lowmode) - if (associated(dd%Polzin_decay_scale)) deallocate(dd%Polzin_decay_scale) - if (associated(dd%Polzin_decay_scale_scaled)) deallocate(dd%Polzin_decay_scale_scaled) - if (associated(dd%N2_bot)) deallocate(dd%N2_bot) - if (associated(dd%N2_meanz)) deallocate(dd%N2_meanz) - if (associated(dd%Kd_Niku)) deallocate(dd%Kd_Niku) - if (associated(dd%Kd_Niku_work)) deallocate(dd%Kd_Niku_work) - if (associated(dd%Kd_Itidal_Work)) deallocate(dd%Kd_Itidal_Work) - if (associated(dd%Kd_Lowmode_Work)) deallocate(dd%Kd_Lowmode_Work) - if (associated(dd%TKE_itidal_used)) deallocate(dd%TKE_itidal_used) - if (associated(dd%N2_int)) deallocate(dd%N2_int) - if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) - if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) - if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) - if (associated(dd%tidal_qe_md)) deallocate(dd%tidal_qe_md) - + if (allocated(CS%dd%Kd_itidal)) deallocate(CS%dd%Kd_itidal) + if (allocated(CS%dd%Kd_lowmode)) deallocate(CS%dd%Kd_lowmode) + if (allocated(CS%dd%Fl_itidal)) deallocate(CS%dd%Fl_itidal) + if (allocated(CS%dd%Fl_lowmode)) deallocate(CS%dd%Fl_lowmode) + if (allocated(CS%dd%Polzin_decay_scale)) deallocate(CS%dd%Polzin_decay_scale) + if (allocated(CS%dd%Polzin_decay_scale_scaled)) deallocate(CS%dd%Polzin_decay_scale_scaled) + if (allocated(CS%dd%N2_bot)) deallocate(CS%dd%N2_bot) + if (allocated(CS%dd%N2_meanz)) deallocate(CS%dd%N2_meanz) + if (allocated(CS%dd%Kd_Niku)) deallocate(CS%dd%Kd_Niku) + if (allocated(CS%dd%Kd_Niku_work)) deallocate(CS%dd%Kd_Niku_work) + if (allocated(CS%dd%Kd_Itidal_Work)) deallocate(CS%dd%Kd_Itidal_Work) + if (allocated(CS%dd%Kd_Lowmode_Work)) deallocate(CS%dd%Kd_Lowmode_Work) + if (allocated(CS%dd%TKE_itidal_used)) deallocate(CS%dd%TKE_itidal_used) + if (allocated(CS%dd%N2_int)) deallocate(CS%dd%N2_int) + if (allocated(CS%dd%vert_dep_3d)) deallocate(CS%dd%vert_dep_3d) + if (allocated(CS%dd%Simmons_coeff_2d)) deallocate(CS%dd%Simmons_coeff_2d) + if (allocated(CS%dd%Schmittner_coeff_3d)) deallocate(CS%dd%Schmittner_coeff_3d) + if (allocated(CS%dd%tidal_qe_md)) deallocate(CS%dd%tidal_qe_md) end subroutine post_tidal_diagnostics !> This subroutine returns a zonal slice of the topographic roughness amplitudes @@ -1538,7 +1521,7 @@ subroutine tidal_mixing_h_amp(h_amp, G, j, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G)), intent(out) :: h_amp !< The topographic roughness amplitude [Z ~> m] integer, intent(in) :: j !< j-index of the row to work on - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(in) :: CS !< The control structure for this module integer :: i @@ -1558,7 +1541,7 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) 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(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local 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] @@ -1587,7 +1570,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_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(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local variables real, parameter :: C1_3 = 1.0/3.0 @@ -1694,7 +1677,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) end subroutine read_tidal_constituents -!> Clear pointers and deallocate memory +!> Deallocate fields subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure, which !! will be deallocated in this routine. @@ -1703,7 +1686,6 @@ subroutine tidal_mixing_end(CS) if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) if (allocated(CS%h_src)) deallocate(CS%h_src) - deallocate(CS%dd) end subroutine tidal_mixing_end end module MOM_tidal_mixing From e50c667796d7bdfad0c7cd50f4fe1315f7140c8a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 8 Oct 2021 17:33:04 -0400 Subject: [PATCH 09/29] Geothermal heating pointer removal * `geothermal_CS` converted from pointers to locals * Instance of `geothermal_CS` in diabatic driver changed to local --- .../vertical/MOM_diabatic_driver.F90 | 18 +++++++-------- .../vertical/MOM_geothermal.F90 | 23 ++++--------------- 2 files changed, 13 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ff9f8fb4dc..d6c45a1508 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -222,7 +222,6 @@ module MOM_diabatic_driver type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module - type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module @@ -235,8 +234,9 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_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(int_tide_CS) :: int_tide !< Internal tide 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(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -549,7 +549,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -1134,7 +1134,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -1686,7 +1686,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal_entraining(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_entraining(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -3393,7 +3393,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! initialize the geothermal heating module if (CS%use_geothermal) & - call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal_CSp, useALEalgorithm) + call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal, useALEalgorithm) ! initialize module for internal tide induced mixing if (CS%use_int_tides) then @@ -3482,10 +3482,8 @@ subroutine diabatic_driver_end(CS) deallocate(CS%set_diff_CSp) - if (CS%use_geothermal) then - call geothermal_end(CS%geothermal_CSp) - deallocate(CS%geothermal_CSp) - endif + if (CS%use_geothermal) & + call geothermal_end(CS%geothermal) if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 877f9a0497..7fdaa6abda 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -65,7 +65,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) !! 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(geothermal_CS), pointer :: CS !< The control structure returned by + type(geothermal_CS), intent(in) :: CS !< The control structure returned by !! a previous call to !! geothermal_init. integer, optional, intent(in) :: halo !< Halo width over which to work @@ -119,8 +119,6 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& - "Module must be initialized before it is used.") if (.not.CS%apply_geothermal) return nkmb = GV%nk_rho_varies @@ -367,8 +365,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) !! to any available thermodynamic fields. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(geothermal_CS), pointer :: CS !< The control structure returned by - !! a previous call to geothermal_init. + type(geothermal_CS), intent(in) :: CS !< Geothermal heating control struct integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables @@ -395,8 +392,6 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& - "Module must be initialized before it is used.") if (.not.CS%apply_geothermal) return Irho_cp = 1.0 / (GV%H_to_RZ * tv%C_p) @@ -497,9 +492,8 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. - type(geothermal_CS), pointer :: CS !< Pointer pointing to the module control - !! structure. - logical, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping + type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control struct + logical, optional, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping ! This include declares and sets the variable "version". #include "version_variable.h" @@ -512,12 +506,6 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith integer :: i, j, isd, ied, jsd, jed, id isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "geothermal_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time @@ -599,8 +587,7 @@ end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. subroutine geothermal_end(CS) - type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control structure that - !! will be deallocated in this subroutine. + type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control struct if (allocated(CS%geo_heat)) deallocate(CS%geo_heat) end subroutine geothermal_end From 1a3a20acd5acec333049bd0aab488eb17fb2b93b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 11 Oct 2021 16:26:28 -0400 Subject: [PATCH 10/29] Opacity pointer removal * Diabatic driver `opacity_CSp` renamed to `opacity`, changed to local * Instances of `optics` and `opacity_CS` converted to locals * Fields in `opacity_CS` and `optics_type` changed to allocatables --- .../vertical/MOM_diabatic_aux.F90 | 10 +-- .../vertical/MOM_diabatic_driver.F90 | 16 ++--- .../vertical/MOM_opacity.F90 | 67 ++++++++----------- 3 files changed, 41 insertions(+), 52 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6739a92cc9..312d114dde 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -590,7 +590,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) end subroutine find_uv_at_h -subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_flow_CSp) +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 @@ -599,7 +599,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ 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(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux - type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + type(opacity_CS) :: opacity !< The control structure for the opacity module. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure !! organizing the tracer modules. @@ -629,7 +629,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_2d=chl_2d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity, chl_2d=chl_2d) else if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & "The tracer flow control structure must be associated when the model sets "//& @@ -639,11 +639,11 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_3d=chl_3d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity, chl_3d=chl_3d) endif else call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity) endif end subroutine set_pen_shortwave diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d6c45a1508..809c962233 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -224,7 +224,6 @@ module MOM_diabatic_driver type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module - type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module @@ -237,6 +236,7 @@ module MOM_diabatic_driver 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(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -563,7 +563,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -1148,7 +1148,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -1700,7 +1700,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) @@ -2523,7 +2523,7 @@ end subroutine layered_diabatic !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth, & KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo) - type(diabatic_CS), intent(in ) :: CS !< module control structure + type(diabatic_CS), target, intent(in) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure type(optics_type), optional, pointer :: optics_CSp !< A pointer to be set to the optics control structure @@ -2539,7 +2539,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, !! assume thermodynamics properties are valid. ! Pointers to control structures - if (present(opacity_CSp)) opacity_CSp => CS%opacity_CSp + if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL_CSp @@ -3449,7 +3449,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity, CS%optics) endif endif @@ -3464,7 +3464,7 @@ subroutine diabatic_driver_end(CS) type(diabatic_CS), intent(inout) :: CS !< module control structure if (associated(CS%optics)) then - call opacity_end(CS%opacity_CSp, CS%optics) + call opacity_end(CS%opacity, CS%optics) deallocate(CS%optics) endif diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 507960cf1f..e61cc3736b 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -25,16 +25,17 @@ module MOM_opacity type, public :: optics_type integer :: nbands !< The number of penetrating bands of SW radiation - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] + real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [m-1] !! The number of radiation bands is most rapidly varying (first) index. - real, pointer, dimension(:,:,:) :: sw_pen_band => NULL() !< shortwave radiation [Q R Z T-1 ~> W m-2] + real, allocatable :: sw_pen_band(:,:,:) !< shortwave radiation [Q R Z T-1 ~> W m-2] !! at the surface in each of the nbands bands that penetrates beyond the surface. !! The most rapidly varying dimension is the band. - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + real, allocatable :: min_wavelength_band(:) + !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + real, allocatable :: max_wavelength_band(:) + !< 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]. @@ -69,7 +70,7 @@ module MOM_opacity !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 - integer, pointer :: id_opacity(:) => NULL() + integer, allocatable :: id_opacity(:) !>@} end type opacity_CS @@ -100,7 +101,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ 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(opacity_CS), pointer :: CS !< The control structure earlier set up by opacity_init. + type(opacity_CS) :: CS !< The control structure earlier set up by opacity_init. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -118,9 +119,6 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ ! summed across all bands [Q R Z T-1 ~> W m-2]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & - "Module must be initialized via opacity_init before it is used.") - if (present(chl_2d) .or. present(chl_3d)) then ! The optical properties are based on cholophyll concentrations. call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & @@ -229,7 +227,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir 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(opacity_CS), pointer :: CS !< The control structure. + type(opacity_CS) :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -925,9 +923,8 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. - type(optics_type), pointer :: optics !< An optics structure that has parameters + type(opacity_CS) :: CS !< Opacity control struct + type(optics_type) :: optics !< An optics structure that has parameters !! set and arrays allocated here. ! Local variables character(len=200) :: tmpstr @@ -945,12 +942,6 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - if (associated(CS)) then - call MOM_error(WARNING, "opacity_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ! Read all relevant parameters and write them to the model log. @@ -1069,9 +1060,9 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) default=PenSW_minthick_dflt, units="m", scale=GV%m_to_H) optics%PenSW_absorb_Invlen = 1.0 / (PenSW_absorb_minthick + GV%H_subroundoff) - if (.not.associated(optics%min_wavelength_band)) & + if (.not.allocated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) - if (.not.associated(optics%max_wavelength_band)) & + if (.not.allocated(optics%max_wavelength_band)) & allocate(optics%max_wavelength_band(optics%nbands)) if (CS%opacity_scheme == MANIZZA_05) then @@ -1093,9 +1084,9 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "The value to use for opacity over land. The default is "//& "10 m-1 - a value for muddy water.", units="m-1", default=10.0) - if (.not.associated(optics%opacity_band)) & + if (.not.allocated(optics%opacity_band)) & allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) - if (.not.associated(optics%sw_pen_band)) & + if (.not.allocated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) allocate(CS%id_opacity(optics%nbands), source=-1) @@ -1116,21 +1107,19 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. - type(optics_type), pointer :: optics !< An optics type structure that should be deallocated. - - if (associated(CS%id_opacity)) deallocate(CS%id_opacity) - if (associated(CS)) deallocate(CS) - - if (associated(optics)) then - if (associated(optics%sw_pen_band)) deallocate(optics%sw_pen_band) - if (associated(optics%opacity_band)) deallocate(optics%opacity_band) - if (associated(optics%max_wavelength_band)) & - deallocate(optics%max_wavelength_band) - if (associated(optics%min_wavelength_band)) & - deallocate(optics%min_wavelength_band) - endif - + type(opacity_CS) :: CS !< Opacity control struct + type(optics_type) :: optics !< An optics type structure that should be deallocated. + + if (allocated(CS%id_opacity)) & + deallocate(CS%id_opacity) + if (allocated(optics%sw_pen_band)) & + deallocate(optics%sw_pen_band) + if (allocated(optics%opacity_band)) & + deallocate(optics%opacity_band) + if (allocated(optics%max_wavelength_band)) & + deallocate(optics%max_wavelength_band) + if (allocated(optics%min_wavelength_band)) & + deallocate(optics%min_wavelength_band) end subroutine opacity_end !> \namespace mom_opacity From 3152a9e312585d6b03da915a52d3568a68a30afe Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 15 Oct 2021 12:12:48 -0400 Subject: [PATCH 11/29] Bulk mixed layer pointer removal * `bulkmixedlayer_CS` pointers moved to locals * Diabatic driver renamed variables: * `bulkmixedlayer` flag -> `use_bulkmixedlayer` * `bulkmixedlayer_CSp` -> `bulkmixedlayer` * Some redundant documentation removed --- .../vertical/MOM_bulk_mixed_layer.F90 | 43 +++++-------------- .../vertical/MOM_diabatic_driver.F90 | 28 ++++++------ 2 files changed, 25 insertions(+), 46 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index be2dfefe8c..ca545c14ad 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -185,8 +185,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), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct type(optics_type), pointer :: optics !< The structure containing the inverse of the !! vertical absorption decay scale for !! penetrating shortwave radiation [m-1]. @@ -329,8 +328,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& - "Module must be initialized before it is used.") if (GV%nkml < 1) return if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & @@ -798,7 +795,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), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment !! (perhaps CS%nkml). @@ -975,7 +972,7 @@ 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), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -1315,7 +1312,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, 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), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. @@ -1525,7 +1522,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & 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), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct ! This subroutine calculates mechanically driven entrainment. @@ -1808,8 +1805,7 @@ 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), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. ! Local variables @@ -1878,8 +1874,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! 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), pointer :: CS !< The control structure for this - !! module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential @@ -2194,8 +2189,7 @@ 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), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, @@ -3090,8 +3084,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), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature @@ -3358,16 +3351,8 @@ 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), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. @@ -3377,12 +3362,6 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 809c962233..c707dc495a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -92,7 +92,7 @@ module MOM_diabatic_driver logical :: use_legacy_diabatic !< If true (default), use a legacy version of the diabatic !! algorithm. This is temporary and is needed to avoid change !! in answers. - logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + logical :: use_bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary !! boundary layer scheme to determine the diffusivity @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module @@ -233,6 +232,7 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_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(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 @@ -1702,7 +1702,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(CS%optics)) & call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) if (CS%ML_mix_first > 0.0) then @@ -1719,11 +1719,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & - eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + eaml, ebml, G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) ! 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_CSp, CS%optics, & + G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) endif @@ -1988,7 +1988,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! If using the bulk mixed layer, T and S are also updated ! by surface fluxes (in fluxes%*). ! This is a very long block. - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (associated(tv%T)) then call cpu_clock_begin(id_clock_tridiag) @@ -2107,7 +2107,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & - G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) ! Keep salinity from falling below a small but positive threshold. @@ -2310,7 +2310,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + if (CS%use_bulkmixedlayer .and. associated(tv%eqn_of_state)) then do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo EOSdom(:) = EOS_domain(G%HI) !$OMP parallel do default(shared) @@ -2359,7 +2359,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! For momentum, it is only the net flux that homogenizes within ! the mixed layer. Vertical viscosity that is proportional to the ! mixed layer turbulence is applied elsewhere. - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (CS%debug) then call hchksum(ea, "before net flux rearrangement ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "before net flux rearrangement eb", G%HI, scale=GV%H_to_m) @@ -2917,7 +2917,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (associated(oda_incupd_CSp)) CS%oda_incupd_CSp => oda_incupd_CSp CS%useALEalgorithm = useALEalgorithm - CS%bulkmixedlayer = (GV%nkml > 0) + CS%use_bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters call log_version(param_file, mdl, version, & @@ -2958,7 +2958,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied "//& "before interior diapycnal mixing. 0 by default.", & @@ -3412,7 +3412,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! set up the clocks for this module id_clock_entrain = cpu_clock_id('(Ocean diabatic entrain)', grain=CLOCK_MODULE) - if (CS%bulkmixedlayer) & + if (CS%use_bulkmixedlayer) & id_clock_mixedlayer = cpu_clock_id('(Ocean mixed layer)', grain=CLOCK_MODULE) id_clock_remap = cpu_clock_id('(Ocean vert remap)', grain=CLOCK_MODULE) if (CS%use_geothermal) & @@ -3434,8 +3434,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%useALEalgorithm, CS%use_energetic_PBL) ! initialize the boundary layer modules - if (CS%bulkmixedlayer) & - call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer_CSp) + if (CS%use_bulkmixedlayer) & + call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL_CSp) From e3d59fe0fd6cf43d03b6046d2599e2f38a3d9fc7 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 15 Oct 2021 15:01:17 -0400 Subject: [PATCH 12/29] Energetic PBL pointer removal * `energetic_PBL_CS` pointers changed to locals in main module * `energetic_PBL_CSp` changed to local and renamed to `energetic_PBL` in diabatic driver. --- .../vertical/MOM_diabatic_driver.F90 | 20 +++++------ .../vertical/MOM_energetic_PBL.F90 | 36 +++++-------------- 2 files changed, 18 insertions(+), 38 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c707dc495a..cefb8bc991 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module @@ -233,6 +232,7 @@ module MOM_diabatic_driver 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(energetic_PBL_CS) :: energetic_PBL !< 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 @@ -779,15 +779,15 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -1315,15 +1315,15 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -2542,7 +2542,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp - if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL_CSp + if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit @@ -3437,7 +3437,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_bulkmixedlayer) & call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & - call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL_CSp) + call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL) call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) @@ -3474,7 +3474,7 @@ subroutine diabatic_driver_end(CS) deallocate(CS%regularize_layers_CSp) if (CS%use_energetic_PBL) & - call energetic_PBL_end(CS%energetic_PBL_CSp) + call energetic_PBL_end(CS%energetic_PBL) call diabatic_aux_end(CS%diabatic_aux_CSp) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 946a40d39e..4a762cd34c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -277,8 +277,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 T-1 ~> m2 s-1]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to energetic_PBL_init. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -345,9 +344,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& - "Module must be initialized before it is used.") - if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & "energetic_PBL: Temperature, salinity and an equation of state "//& "must now be used.") @@ -526,8 +522,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !! [Z T-1 ~> m s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to energetic_PBL_init. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -731,9 +726,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& - "Module must be initialized before it is used.") - debug = .false. ! Change this hard-coded value for debugging. calc_Te = (debug .or. (.not.CS%orig_PE_calc)) @@ -1718,7 +1710,7 @@ end subroutine find_PE_chg_orig subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& MStar_LT, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1] real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1] @@ -1804,7 +1796,7 @@ end subroutine Find_Mstar !> This subroutine modifies the Mstar value if the Langmuir number is present subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, & Mstar, MStar_LT, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1] real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] @@ -1890,7 +1882,7 @@ end subroutine Mstar_Langmuir !> Copies the ePBL active mixed layer depth into MLD, in units of [Z ~> m] unless other units are specified. subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) - type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control struct type(ocean_grid_type), intent(in) :: G !< Grid structure 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 @@ -1917,8 +1909,8 @@ subroutine energetic_PBL_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 !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output - type(energetic_PBL_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct + ! Local variables ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1932,12 +1924,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "energetic_PBL_init called with an associated"//& - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time @@ -2360,14 +2346,11 @@ end subroutine energetic_PBL_init !> Clean up and deallocate memory associated with the energetic_PBL module. subroutine energetic_PBL_end(CS) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure that - !! will be deallocated in this subroutine. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic_PBL control struct character(len=256) :: mesg real :: avg_its - if (.not.associated(CS)) return - if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) if (allocated(CS%LA)) deallocate(CS%LA) if (allocated(CS%LA_MOD)) deallocate(CS%LA_MOD) @@ -2390,9 +2373,6 @@ subroutine energetic_PBL_end(CS) write (mesg,*) "Average ePBL iterations = ", avg_its call MOM_mesg(mesg) endif - - deallocate(CS) - end subroutine energetic_PBL_end !> \namespace MOM_energetic_PBL From d6e98dc8fac630b1f9e7bbc8963bbcb5c00bcebc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 15 Oct 2021 15:43:28 -0400 Subject: [PATCH 13/29] Regularize layers pointer removal * `regularize_layer_CS` pointers in module moved to local * `regularize_layer_CSp` in diabatic driver moved to local * diabatic drriver `regularize_layer_CSp` renamed to drop `_CSp` --- .../vertical/MOM_diabatic_driver.F90 | 8 +++--- .../vertical/MOM_regularize_layers.F90 | 27 +++++-------------- 2 files changed, 10 insertions(+), 25 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index cefb8bc991..5b33ec5f95 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module @@ -237,6 +236,7 @@ module MOM_diabatic_driver 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(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -2183,7 +2183,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers_CSp) + call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers) call cpu_clock_end(id_clock_remap) if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) @@ -3439,7 +3439,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL) - call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) + call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers) if (CS%debug_energy_req) & call diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS%diapyc_en_rec_CSp) @@ -3471,8 +3471,6 @@ subroutine diabatic_driver_end(CS) if (CS%debug_energy_req) & call diapyc_energy_req_end(CS%diapyc_en_rec_CSp) - deallocate(CS%regularize_layers_CSp) - if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index af92e522a2..f42b1ae7ee 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -86,16 +86,13 @@ 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), pointer :: CS !< The control structure returned by a previous - !! call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + ! Local variables 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. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& - "Module must be initialized before it is used.") - if (CS%regularize_surface_layers) then call pass_var(h, G%Domain, clock=id_clock_pass) call regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) @@ -123,8 +120,8 @@ 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), pointer :: CS !< The control structure returned by a previous - !! call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & def_rat_u ! The ratio of the thickness deficit to the minimum depth [nondim]. @@ -194,9 +191,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& - "Module must be initialized before it is used.") - if (GV%nkml<1) return nkmb = GV%nk_rho_varies ; nkml = GV%nkml if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, & @@ -623,8 +617,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), pointer :: CS !< The control structure returned by a - !! previous call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -719,8 +712,8 @@ 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), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control struct + #include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. logical :: use_temperature @@ -729,12 +722,6 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "regularize_layers_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time From 5d0160a817771eeab012d9dcd30ef32f85d1f09d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 16 Oct 2021 11:50:14 -0400 Subject: [PATCH 14/29] CVMix convection pointer removal * `CVMix_conv_CS` in diabatic driver renamed to `CVMix_conv` * Pointer instances of `CVMix_conv_CS` changed to locals * `CVMix_end` function removed, since it did nothing. --- .../vertical/MOM_CVMix_conv.F90 | 23 ++++--------------- .../vertical/MOM_diabatic_driver.F90 | 16 ++++++------- 2 files changed, 11 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 02edda1b51..6b44fce15e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -21,7 +21,7 @@ module MOM_CVMix_conv #include -public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_end, CVMix_conv_is_used +public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_is_used !> Control structure including parameters for CVMix convection. type, public :: CVMix_conv_cs ; private @@ -55,20 +55,14 @@ 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), pointer :: CS !< This module's control structure. - ! Local variables + type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convetction control struct + 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" - if (associated(CS)) then - call MOM_error(WARNING, "CVMix_conv_init called with an associated "// & - "control structure.") - return - endif - ! Read parameters call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & @@ -82,7 +76,6 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) default=.false.) if (.not. CVMix_conv_init) return - allocate(CS) call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, default=.false., & do_not_log=.true.) @@ -146,8 +139,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), pointer :: CS !< The control structure returned - !! by a previous call to CVMix_conv_init. + type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control struct 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 @@ -305,11 +297,4 @@ logical function CVMix_conv_is_used(param_file) end function CVMix_conv_is_used -!> Clear pointers and dealocate memory -! NOTE: Placeholder destructor -subroutine CVMix_conv_end(CS) - type(CVMix_conv_cs), pointer :: CS !< Control structure for this module that - !! will be deallocated in this subroutine -end subroutine CVMix_conv_end - end module MOM_CVMix_conv diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 5b33ec5f95..9aa953ed06 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -23,7 +23,7 @@ module MOM_diabatic_driver use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs -use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv +use MOM_CVMix_conv, only : calculate_CVMix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init @@ -227,10 +227,10 @@ module MOM_diabatic_driver type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module type(optics_type), pointer :: optics => NULL() !< Control structure for a child module type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module - type(CVMix_conv_cs), pointer :: CVMix_conv_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) :: energetic_PBL !< Energetic PBL control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct @@ -723,7 +723,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_int, visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) endif ! This block sets ent_t and ent_s from h and Kd_int. @@ -1276,9 +1276,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection if (CS%useKPP) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) else - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) endif endif @@ -1866,7 +1866,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_int, visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) endif if (CS%useKPP) then @@ -3386,7 +3386,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise it is False. - CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv_CSp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv) call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive, & just_read_params=CS%useALEalgorithm) @@ -3483,8 +3483,6 @@ subroutine diabatic_driver_end(CS) if (CS%use_geothermal) & call geothermal_end(CS%geothermal) - if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) - if (CS%useKPP) then deallocate( CS%KPP_buoy_flux ) deallocate( CS%KPP_temp_flux ) From 65a351631284af6b6ca44f00b56f3276c0cdd50b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 18 Oct 2021 13:29:10 -0400 Subject: [PATCH 15/29] MEKE_type pointer removal * `MEKE_type` pointers of many arguments and control structures changed from pointers to locals * `MEKE` input removed from the following: * `initialize_dyn_unsplit` * `initialize_dyn_unsplit_RK2` * Many `associated(MEKE)` checks have been removed, and now rely on associations of individual components within MEKE This is just "passing the buck" and not solving the underlying issue of decision-by-allocation, but it's closer to a true solution. * Pointer fields inside `MEKE_type` converted to allocatables `associated()` tests for them replaced with `allocatable()` --- src/core/MOM.F90 | 12 +- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 5 +- src/parameterizations/lateral/MOM_MEKE.F90 | 113 ++++++++---------- .../lateral/MOM_MEKE_types.F90 | 31 ++--- .../lateral/MOM_hor_visc.F90 | 35 +++--- .../lateral/MOM_thickness_diffuse.F90 | 36 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 6 +- 9 files changed, 109 insertions(+), 139 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 98e94c0592..c4cbcf3960 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -227,8 +227,7 @@ module MOM type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing type(vertvisc_type) :: visc !< structure containing vertical viscosities, !! bottom drag viscosities, and related fields - type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields - !! related to the Mesoscale Eddy Kinetic Energy + type(MEKE_type) :: MEKE !< Fields related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time @@ -2663,13 +2662,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) endif @@ -3622,10 +3621,7 @@ subroutine MOM_end(CS) if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) - if (associated(CS%MEKE)) then - call MEKE_end(CS%MEKE) - deallocate(CS%MEKE) - endif + call MEKE_end(CS%MEKE) if (associated(CS%tv%internal_heat)) deallocate(CS%tv%internal_heat) if (associated(CS%tv%TempxPmE)) deallocate(CS%tv%TempxPmE) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 14741dbbd1..f5af5bb8ae 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -289,7 +289,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing @@ -1258,7 +1258,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 5f525596b5..e8627b7735 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -218,8 +218,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields !! that specify the spatially variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing - !! fields related to the Mesoscale Eddy Kinetic Energy. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -551,7 +550,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & + restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -581,7 +580,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. - type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions are !! used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 42efec91f9..9ea0300f0e 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -230,7 +230,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with !! fields that specify the spatially !! variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. ! Local variables @@ -499,7 +499,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & + restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -526,7 +526,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. - type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions !! are used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 5b58280277..551caa625e 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -112,7 +112,7 @@ module MOM_MEKE !> Integrates forward-in-time the MEKE eddy energy equation. !! See \ref section_MEKE_equations. subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, hv) - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields 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 @@ -175,9 +175,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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 (.not.associated(MEKE)) call MOM_error(FATAL, & - "MOM_MEKE: MEKE must be initialized before it is used.") - if ((CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) .or. CS%visc_drag) then use_drag_rate = .true. else @@ -185,19 +182,20 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Only integrate the MEKE equations if MEKE is required. - if (.not.associated(MEKE%MEKE)) then + if (.not. allocated(MEKE%MEKE)) then ! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") return endif if (CS%debug) then - if (associated(MEKE%mom_src)) & + if (allocated(MEKE%mom_src)) & call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%GME_snk)) & + if (allocated(MEKE%GME_snk)) & call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%GM_src)) & + if (allocated(MEKE%GM_src)) & call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) + if (allocated(MEKE%MEKE)) & + 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, & @@ -323,21 +321,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h src(i,j) = CS%MEKE_BGsrc enddo ; enddo - if (associated(MEKE%mom_src)) then + if (allocated(MEKE%mom_src)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) enddo ; enddo endif - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif - if (associated(MEKE%GM_src)) then + if (allocated(MEKE%GM_src)) then if (CS%GM_src_alt) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie @@ -471,10 +469,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_here = max(0., CS%MEKE_Kh) + & CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) - if (associated(MEKE%Kh_diff)) & + if (allocated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + & CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -489,9 +487,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) - if (associated(MEKE%Kh_diff)) & + if (allocated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -612,7 +610,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif - if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) then + if (allocated(MEKE%Kh) .or. allocated(MEKE%Ku) .or. allocated(MEKE%Au)) then call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Kh, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -674,7 +672,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), intent(in) :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution @@ -871,7 +869,7 @@ end subroutine MEKE_equilibrium_restoring subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & bottomFac2, barotrFac2, LmixScale) type(MEKE_CS), intent(in) :: CS !< MEKE control structure. - type(MEKE_type), intent(in) :: MEKE !< MEKE data. + type(MEKE_type), intent(in) :: MEKE !< MEKE field 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 @@ -1023,7 +1021,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE-related fields. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables @@ -1051,13 +1049,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) default=.false.) if (.not. MEKE_init) return - if (.not. associated(MEKE)) then - ! The MEKE structure should have been allocated in MEKE_alloc_register_restart() - call MOM_error(WARNING, "MEKE_init called with NO associated "// & - "MEKE-type structure.") - return - endif - call MOM_mesg("MEKE_init: reading parameters ", 5) ! Read all relevant parameters and write them to the model log. @@ -1258,25 +1249,25 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_MEKE = -1 CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & 'MEKE derived diffusivity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 + if (.not. allocated(MEKE%Kh)) CS%id_Kh = -1 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 + if (.not. allocated(MEKE%Ku)) CS%id_Ku = -1 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) - if (.not. associated(MEKE%Au)) CS%id_Au = -1 + if (.not. allocated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ue = -1 CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & 'MEKE derived bottom eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ub = -1 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & 'MEKE derived barotropic eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ut = -1 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3', conversion=(US%L_T_to_m_s**2)*US%s_to_T) CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & @@ -1284,15 +1275,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & 'MEKE energy available from thickness mixing', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 + if (.not. allocated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & 'MEKE energy available from momentum', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 + if (.not. allocated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & 'MEKE energy lost to GME backscatter', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 + if (.not. allocated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & @@ -1336,31 +1327,31 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) L_rescale = US%m_to_L / US%m_to_L_restart if (L_rescale*I_T_rescale /= 1.0) then - if (associated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) 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 * MEKE%MEKE(i,j) enddo ; enddo endif ; endif endif if (L_rescale**2*I_T_rescale /= 1.0) then - if (associated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) 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 (associated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then + 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 (associated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then + 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 (associated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) 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 @@ -1368,16 +1359,16 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) endif ! Set up group passes. In the case of a restart, these fields need a halo update now. - if (associated(MEKE%MEKE)) then + if (allocated(MEKE%MEKE)) then call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) - if (associated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) + if (allocated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) if (.not.CS%initialize) call do_group_pass(CS%pass_MEKE, G%Domain) endif - if (associated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) - if (associated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) - if (associated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) + if (allocated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + if (allocated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) + if (allocated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) - if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) & + if (allocated(MEKE%Kh) .or. allocated(MEKE%Ku) .or. allocated(MEKE%Au)) & call do_group_pass(CS%pass_Kh, G%Domain) end function MEKE_init @@ -1387,7 +1378,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. - type(MEKE_type), pointer :: MEKE !< A structure with MEKE-related fields. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables type(vardesc) :: vd @@ -1407,12 +1398,6 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) MEKE_viscCoeff_Ku =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_KU",MEKE_viscCoeff_Ku) MEKE_viscCoeff_Au =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_AU",MEKE_viscCoeff_Au) Use_KH_in_MEKE = .false.; call read_param(param_file,"USE_KH_IN_MEKE", Use_KH_in_MEKE) -! Allocate control structure - if (associated(MEKE)) then - call MOM_error(WARNING, "MEKE_alloc_register_restart called with an associated "// & - "MEKE type.") - return - else; allocate(MEKE); endif if (.not. useMEKE) return @@ -1464,15 +1449,15 @@ subroutine MEKE_end(MEKE) ! So these must all be conditional, even though MEKE%MEKE and MEKE%Rd_dx_h ! are always allocated (when MEKE is enabled) - if (associated(MEKE%Au)) deallocate(MEKE%Au) - if (associated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) - if (associated(MEKE%Ku)) deallocate(MEKE%Ku) - if (associated(MEKE%Rd_dx_h)) deallocate(MEKE%Rd_dx_h) - if (associated(MEKE%Kh)) deallocate(MEKE%Kh) - if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) - if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) - if (associated(MEKE%GM_src)) deallocate(MEKE%GM_src) - if (associated(MEKE%MEKE)) deallocate(MEKE%MEKE) + if (allocated(MEKE%Au)) deallocate(MEKE%Au) + if (allocated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) + if (allocated(MEKE%Ku)) deallocate(MEKE%Ku) + if (allocated(MEKE%Rd_dx_h)) deallocate(MEKE%Rd_dx_h) + if (allocated(MEKE%Kh)) deallocate(MEKE%Kh) + if (allocated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) + if (allocated(MEKE%mom_src)) deallocate(MEKE%mom_src) + if (allocated(MEKE%GM_src)) deallocate(MEKE%GM_src) + if (allocated(MEKE%MEKE)) deallocate(MEKE%MEKE) end subroutine MEKE_end !> \namespace mom_meke diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 01a602157a..57de7c0b02 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -7,21 +7,22 @@ module MOM_MEKE_types !> This type is used to exchange information related to the MEKE calculations. type, public :: MEKE_type ! Variables - real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [R Z L2 T-3 ~> W m-2]. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [R Z L2 T-3 ~> W m-2]. - GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [R Z L2 T-3 ~> W m-2]. - Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. - Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse - !! MEKE [L2 T-1 ~> m2 s-1]. - Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. - !! Rd_dx_h is copied from VarMix_CS. - real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient - !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing - !! backscatter from unresolved eddies (see Jansen and Held, 2014). - real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity - !! coefficient [L4 T-1 ~> m4 s-1]. + real, allocatable :: MEKE(:,:) !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + real, allocatable :: GM_src(:,:) !< MEKE source due to thickness mixing (GM) [R Z L2 T-3 ~> W m-2]. + real, allocatable :: mom_src(:,:) !< MEKE source from lateral friction in the + !! momentum equations [R Z L2 T-3 ~> W m-2]. + real, allocatable :: GME_snk(:,:) !< MEKE sink from GME backscatter in the momentum equations [R Z L2 T-3 ~> W m-2]. + real, allocatable :: Kh(:,:) !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. + real, allocatable :: Kh_diff(:,:) !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse + !! MEKE [L2 T-1 ~> m2 s-1]. + real, allocatable :: Rd_dx_h(:,:) !< The deformation radius compared with the grid spacing [nondim]. + !! Rd_dx_h is copied from VarMix_CS. + real, allocatable :: Ku(:,:) !< The MEKE-derived lateral viscosity coefficient + !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! backscatter from unresolved eddies (see Jansen and Held, 2014). + real, allocatable :: Au(:,:) !< The MEKE-derived lateral biharmonic viscosity + !! coefficient [L4 T-1 ~> m4 s-1]. + ! 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]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0b733514a7..0e0fa789d2 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -233,7 +233,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: diffv !< Meridional acceleration due to convergence !! of along-coordinate stress tensor [L T-2 ~> m s-2]. - type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities @@ -420,21 +420,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, find_FrictWork = (CS%id_FrictWork > 0) if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. - if (associated(MEKE)) then - if (associated(MEKE%mom_src)) find_FrictWork = .true. - backscat_subround = 0.0 - if (find_FrictWork .and. associated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & - (MEKE%backscatter_Ro_Pow /= 0.0)) & - backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) - endif + + if (allocated(MEKE%mom_src)) find_FrictWork = .true. + backscat_subround = 0.0 + if (find_FrictWork .and. allocated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & + (MEKE%backscatter_Ro_Pow /= 0.0)) & + backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) ! Toggle whether to use a Laplacian viscosity derived from MEKE - if (associated(MEKE)) then - use_MEKE_Ku = associated(MEKE%Ku) - use_MEKE_Au = associated(MEKE%Au) - else - use_MEKE_Ku = .false. ; use_MEKE_Au = .false. - endif + use_MEKE_Ku = allocated(MEKE%Ku) + use_MEKE_Au = allocated(MEKE%Au) rescale_Kh = .false. if (associated(VarMix)) then @@ -1468,7 +1463,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif enddo ; enddo - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo @@ -1557,12 +1552,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Make a similar calculation as for FrictWork above but accumulating into ! the vertically integrated MEKE source term, and adjusting for any ! energy loss seen as a reduction in the (biharmonic) frictional source term. - if (find_FrictWork .and. associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + if (find_FrictWork .and. allocated(MEKE%mom_src)) then if (k==1) then do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = 0. enddo ; enddo - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie MEKE%GME_snk(i,j) = 0. enddo ; enddo @@ -1615,13 +1610,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork(i,j,k) enddo ; enddo - if (CS%use_GME .and. associated(MEKE)) then ; if (associated(MEKE%GME_snk)) then + if (CS%use_GME .and. allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) enddo ; enddo - endif ; endif + endif - endif ; endif ! find_FrictWork and associated(mom_src) + endif ! find_FrictWork and associated(mom_src) enddo ! end of k loop diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c68558a647..8106d3d130 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -115,7 +115,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(VarMix_CS), pointer :: 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 @@ -160,16 +160,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave 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%thickness_diffuse) .or. & - .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return + if ((.not.CS%thickness_diffuse) .or. .not.(CS%Khth > 0.0 .or. associated(VarMix))) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff - if (associated(MEKE)) then - if (associated(MEKE%GM_src)) then - do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo - endif + if (allocated(MEKE%GM_src)) then + do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo endif use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. @@ -225,7 +222,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then !$OMP do do j=js,je ; do I=is-1,ie @@ -238,7 +235,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp Khth_loc_u(I,j) = Khth_loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif - endif ; endif + endif if (Resoln_scaled) then !$OMP do @@ -311,7 +308,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo endif endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then !$OMP do do J=js-1,je ; do i=is,ie @@ -324,7 +321,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp Khth_loc_v(i,J) = Khth_loc_v(i,J) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif - endif ; endif + endif if (Resoln_scaled) then !$OMP do @@ -387,7 +384,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ; enddo endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then if (CS%MEKE_GEOM_answers_2018) then !$OMP do @@ -409,7 +406,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo endif endif - endif ; endif + endif !$OMP do @@ -448,8 +445,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp int_slope_u, int_slope_v) endif - if (associated(MEKE) .AND. associated(VarMix)) then - if (associated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then + if (associated(VarMix)) then + if (allocated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then !$OMP parallel do default(none) shared(is,ie,js,je,MEKE,VarMix) do j=js,je ; do i=is,ie MEKE%Rd_dx_h(i,j) = VarMix%Rd_dx_h(i,j) @@ -574,7 +571,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt !< Time increment [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion 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 @@ -721,8 +718,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV hN2_x_PE(:,:,:) = 0.0 hN2_y_PE(:,:,:) = 0.0 - find_work = .false. - if (associated(MEKE)) find_work = associated(MEKE%GM_src) + find_work = allocated(MEKE%GM_src) find_work = (allocated(CS%GMwork) .or. find_work) if (use_EOS) then @@ -1408,12 +1404,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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 - if (associated(MEKE) .and. .not.CS%GM_src_alt) then ; if (associated(MEKE%GM_src)) then + if (.not. CS%GM_src_alt) then ; if (allocated(MEKE%GM_src)) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h endif ; endif enddo ; enddo ; endif - if (find_work .and. CS%GM_src_alt .and. associated(MEKE)) then ; if (associated(MEKE%GM_src)) then + if (find_work .and. CS%GM_src_alt) then ; if (allocated(MEKE%GM_src)) then do j=js,je ; do i=is,ie ; do k=nz,1,-1 PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index eb59dcc74f..a5d07a6c23 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -109,7 +109,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE type + type(MEKE_type), intent(in) :: MEKE !< MEKE fields type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure @@ -219,7 +219,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & @@ -236,7 +236,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & From 1cef96cd9e09bbfadd78b2ca0628047fa035dce1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 19 Oct 2021 08:34:36 -0400 Subject: [PATCH 16/29] Variable mixing pointer removal * `VarMix_CS` pointer instances redefined as locals * `associated(VarMix)` tests replaced with `VarMix%use_variable_mixing`. This ought to be identical, since `VarMix_init()` deallocates the CS if this flag is unset (False), and the function is always called. * VarMix arrays changed from pointers to allocatables --- src/core/MOM.F90 | 19 +- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 3 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +- .../lateral/MOM_hor_visc.F90 | 9 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 174 ++++++++---------- .../lateral/MOM_mixed_layer_restrat.F90 | 7 +- .../lateral/MOM_thickness_diffuse.F90 | 13 +- src/tracer/MOM_tracer_hor_diff.F90 | 6 +- 9 files changed, 105 insertions(+), 134 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c4cbcf3960..1adcbec3aa 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -357,8 +357,8 @@ module MOM !< Pointer to the control structure for the diabatic driver type(MEKE_CS) :: MEKE_CSp !< Pointer to the control structure for the MEKE updates - type(VarMix_CS), pointer :: VarMix => NULL() - !< Pointer to the control structure for the variable mixing module + type(VarMix_CS) :: VarMix + !< Control structure for the variable mixing module type(Barotropic_CS), pointer :: Barotropic_CSp => NULL() !< Pointer to the control structure for the barotropic module type(tracer_registry_type), pointer :: tracer_Reg => NULL() @@ -636,7 +636,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS CS%time_in_cycle = 0.0 do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call enable_averages(cycle_time, Time_start + real_to_time(US%T_to_s*cycle_time), CS%diag) call calc_resoln_function(h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -1032,7 +1032,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call enable_averages(dt_thermo, Time_local+real_to_time(US%T_to_s*(dt_thermo-dt)), CS%diag) call cpu_clock_begin(id_clock_thick_diff) - if (associated(CS%VarMix)) & + if (CS%VarMix%use_variable_mixing) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1111,7 +1111,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) - if (associated(CS%VarMix)) & + if (CS%VarMix%use_variable_mixing) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1562,7 +1562,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Perform offline diffusion if requested if (.not. skip_diffusion) then - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -1588,7 +1588,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -3613,10 +3613,7 @@ subroutine MOM_end(CS) call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - if (associated(CS%VarMix)) then - call VarMix_end(CS%VarMix) - deallocate(CS%VarMix) - endif + call VarMix_end(CS%VarMix) if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f5af5bb8ae..ded91709f6 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -288,7 +288,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities @@ -1257,7 +1257,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass !! diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities + type(VarMix_CS), intent(inout) :: VarMix !< points to spatially variable viscosities type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index e8627b7735..1d1a2b11b8 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -216,8 +216,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields - !! that specify the spatially variable viscosities. + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 9ea0300f0e..554c6fb2ed 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -227,9 +227,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with - !! fields that specify the spatially - !! variable viscosities. + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0e0fa789d2..d4ba595de3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -235,8 +235,7 @@ 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), pointer :: VarMix !< Pointer to a structure with fields that - !! specify the spatially variable viscosities + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type @@ -432,10 +431,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, use_MEKE_Au = allocated(MEKE%Au) rescale_Kh = .false. - if (associated(VarMix)) then + if (VarMix%use_variable_mixing) then rescale_Kh = VarMix%Resoln_scaled_Kh - if ((rescale_Kh .or. CS%res_scale_MEKE) .and. & - (.not.associated(VarMix%Res_fn_h) .or. .not.associated(VarMix%Res_fn_q))) & + 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.") elseif (CS%res_scale_MEKE) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9306233112..9a0e0c86ea 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -63,46 +63,46 @@ 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, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [T-1 ~> s-1] - SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] - L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] - L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. - Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at h points [nondim]. - Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at q points [nondim]. - Res_fn_u => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at u points [nondim]. - Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at v points [nondim]. - Depth_fn_u => NULL(), & !< Non-dimensional function of the ratio of the depth to - !! a reference depth (maximum 1) at u points [nondim] - Depth_fn_v => NULL(), & !< Non-dimensional function of the ratio of the depth to - !! a reference depth (maximum 1) at v points [nondim] - beta_dx2_h => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at h points [L T-1 ~> m s-1]. - beta_dx2_q => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at q points [L T-1 ~> m s-1]. - beta_dx2_u => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at u points [L T-1 ~> m s-1]. - beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at v points [L T-1 ~> m s-1]. - f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [L2 T-2 ~> m2 s-2]. - f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [L2 T-2 ~> m2 s-2]. - f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [L2 T-2 ~> m2 s-2]. - f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [L2 T-2 ~> m2 s-2]. - Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] - - real, dimension(:,:,:), pointer :: & - slope_x => NULL(), & !< Zonal isopycnal slope [nondim] - slope_y => NULL(), & !< Meridional isopycnal slope [nondim] - ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] + + 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] + real, allocatable :: L2u(:,:) !< Length scale^2 at u-points [L2 ~> m2] + real, allocatable :: L2v(:,:) !< Length scale^2 at v-points [L2 ~> m2] + real, allocatable :: cg1(:,:) !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. + real, allocatable :: Res_fn_h(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at h points [nondim]. + real, allocatable :: Res_fn_q(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at q points [nondim]. + real, allocatable :: Res_fn_u(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at u points [nondim]. + real, allocatable :: Res_fn_v(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at v points [nondim]. + real, allocatable :: Depth_fn_u(:,:) !< Non-dimensional function of the ratio of the depth to + !! a reference depth (maximum 1) at u points [nondim] + real, allocatable :: Depth_fn_v(:,:) !< Non-dimensional function of the ratio of the depth to + !! a reference depth (maximum 1) at v points [nondim] + real, allocatable :: beta_dx2_h(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at h points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_q(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at q points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_u(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at u points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_v(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at v points [L T-1 ~> m s-1]. + real, allocatable :: f2_dx2_h(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at h [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_q(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at q [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_u(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at u [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_v(:,:) !< The Coriolis parameter squared times the grid + !! 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 :: ebt_struct(:,:,:) !< Vertical structure function to scale diffusivities with [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] @@ -164,8 +164,8 @@ 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), pointer :: CS !< Variable mixing coefficients + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct ! Local variables integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -175,12 +175,10 @@ subroutine calc_depth_function(G, 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 - if (.not. associated(CS)) call MOM_error(FATAL, "calc_depth_function:"// & - "Module must be initialized before it is used.") if (.not. CS%calculate_depth_fns) return - if (.not. associated(CS%Depth_fn_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%Depth_fn_u)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_u is not associated with Depth_scaled_KhTh.") - if (.not. associated(CS%Depth_fn_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%Depth_fn_v)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_v is not associated with Depth_scaled_KhTh.") H0 = CS%depth_scaled_khth_h0 @@ -203,7 +201,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), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some @@ -218,13 +216,11 @@ subroutine calc_resoln_function(h, tv, 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 - if (.not. associated(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & - "Module must be initialized before it is used.") if (CS%calculate_cg1) then - if (.not. associated(CS%cg1)) call MOM_error(FATAL, & + 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 (.not. associated(CS%ebt_struct)) call MOM_error(FATAL, & + 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 ! Both resolution fn and vertical structure are using EBT @@ -247,7 +243,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) ! Calculate and store the ratio between deformation radius and grid-spacing ! at h-points [nondim]. if (CS%calculate_rd_dx) then - if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -261,29 +257,29 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (.not. CS%calculate_res_fns) return - if (.not. associated(CS%Res_fn_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_h)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_q)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_u)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_v)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_v is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_v is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_v is not associated with Resoln_scaled_Kh.") ! Do this calculation on the extent used in MOM_hor_visc.F90, and @@ -450,7 +446,7 @@ 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), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & @@ -462,9 +458,6 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: dzSxN ! |Sx| N times dz at u-points [Z T-1 ~> m s-1] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: dzSyN ! |Sy| N times dz at v-points [Z T-1 ~> m s-1] - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& - "Module must be initialized before it is used.") - if (CS%calculate_Eady_growth_rate) then if (CS%use_simpler_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) @@ -514,7 +507,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C 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), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables @@ -531,12 +524,10 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C real :: S2_v(SZI_(G), SZJB_(G)) logical :: local_open_u_BC, local_open_v_BC - if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & - "Module must be initialized before it is used.") if (.not. CS%calculate_Eady_growth_rate) return - if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -669,11 +660,11 @@ end subroutine calc_Visbeck_coeffs_old !> Calculates the Eady growth rate (2D fields) for use in MEKE and the Visbeck schemes subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, SN_u, SN_v) - type(VarMix_CS), intent(in) :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients 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(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer, intent(in) :: OBC !< Open boundaries control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface height [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzu !< dz at u-points [Z ~> m] @@ -855,7 +846,7 @@ 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), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct 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 @@ -878,12 +869,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) logical :: local_open_u_BC, local_open_v_BC - if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & - "Module must be initialized before it is used.") if (.not. CS%calculate_Eady_growth_rate) return - if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1014,7 +1003,7 @@ end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean 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 @@ -1149,7 +1138,7 @@ subroutine VarMix_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 !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when @@ -1179,13 +1168,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "VarMix_init called with an associated "// & - "control structure.") - return - endif - - allocate(CS) in_use = .false. ! Set to true to avoid deallocating CS%diag => diag ! Diagnostics pointer CS%calculate_cg1 = .false. @@ -1594,14 +1576,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "USE_STORED_SLOPES must be True when using QG Leith.") endif - ! If nothing is being stored in this class then deallocate - if (in_use) then - CS%use_variable_mixing = .true. - else - deallocate(CS) - return - endif - + ! Re-enable variable mixing if one of the schemes was enabled + CS%use_variable_mixing = in_use .or. CS%use_variable_mixing end subroutine VarMix_init !> Destructor for VarMix control structure @@ -1621,8 +1597,8 @@ subroutine VarMix_end(CS) deallocate(CS%SN_v) endif - if (associated(CS%L2u)) deallocate(CS%L2u) - if (associated(CS%L2v)) deallocate(CS%L2v) + if (allocated(CS%L2u)) deallocate(CS%L2u) + if (allocated(CS%L2v)) deallocate(CS%L2v) if (CS%Resoln_scaling_used) then deallocate(CS%Res_fn_h) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 7d84120f9c..9cfbf8f5f8 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -101,7 +101,7 @@ 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 !! PBL scheme [Z ~> m] - type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure if (GV%nkml>0) then @@ -128,7 +128,7 @@ 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), pointer :: VarMix !< Container for derived fields + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct 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] @@ -196,7 +196,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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.associated(VarMix) .and. CS%front_length>0.) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & + call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "The resolution argument, Rd/dx, was not associated.") if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8106d3d130..7382459c16 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -116,7 +116,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients + 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 ! Local variables @@ -160,7 +160,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave 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%thickness_diffuse) .or. .not.(CS%Khth > 0.0 .or. associated(VarMix))) return + if ((.not.CS%thickness_diffuse) & + .or. .not. (CS%Khth > 0.0 .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 @@ -173,7 +174,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp khth_use_ebt_struct = .false. ; use_Visbeck = .false. ; use_QG_Leith = .false. Depth_scaled = .false. - if (associated(VarMix)) then + if (VarMix%use_variable_mixing) then use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) Resoln_scaled = VarMix%Resoln_scaled_KhTh Depth_scaled = VarMix%Depth_scaled_KhTh @@ -181,7 +182,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp khth_use_ebt_struct = VarMix%khth_use_ebt_struct use_Visbeck = VarMix%use_Visbeck use_QG_Leith = VarMix%use_QG_Leith_GM - if (associated(VarMix%cg1)) cg1 => VarMix%cg1 + if (allocated(VarMix%cg1)) cg1 => VarMix%cg1 else cg1 => null() endif @@ -445,8 +446,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp int_slope_u, int_slope_v) endif - if (associated(VarMix)) then - if (allocated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then + if (VarMix%use_variable_mixing) then + if (allocated(MEKE%Rd_dx_h) .and. allocated(VarMix%Rd_dx_h)) then !$OMP parallel do default(none) shared(is,ie,js,je,MEKE,VarMix) do j=js,je ; do i=is,ie MEKE%Rd_dx_h(i,j) = VarMix%Rd_dx_h(i,j) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index a5d07a6c23..850480e3e6 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -110,7 +110,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] type(MEKE_type), intent(in) :: MEKE !< MEKE fields - type(VarMix_CS), pointer :: VarMix !< Variable mixing type + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers @@ -176,7 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online "register_tracer must be called before tracer_hordiff.") if (LOC(Reg)==0) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "register_tracer must be called before tracer_hordiff.") - if ((Reg%ntr==0) .or. ((CS%KhTr <= 0.0) .and. .not.associated(VarMix)) ) return + if (Reg%ntr == 0 .or. (CS%KhTr <= 0.0 .and. .not. VarMix%use_variable_mixing)) return if (CS%show_call_tree) call callTree_enter("tracer_hordiff(), MOM_tracer_hor_diff.F90") @@ -199,7 +199,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%debug) call MOM_tracer_chksum("Before tracer diffusion ", Reg%Tr, ntr, G) use_VarMix = .false. ; Resoln_scaled = .false. ; use_Eady = .false. - if (Associated(VarMix)) then + if (VarMix%use_variable_mixing) then use_VarMix = VarMix%use_variable_mixing Resoln_scaled = VarMix%Resoln_scaled_KhTr use_Eady = CS%KhTr_Slope_Cff > 0. From bbf0f5221d35f1e7088bec35b5bf16fa194f555a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 19 Oct 2021 11:49:20 -0400 Subject: [PATCH 17/29] Wave speed pointer removal * `wave_speed_CS` pointers redefined as locals * `wave_speed_CSp` in varmix and diagnostics renamed to `wave_speed` * `S` and `T` pointers removed wave speed update --- src/diagnostics/MOM_diagnostics.F90 | 13 +++---- src/diagnostics/MOM_wave_speed.F90 | 37 +++++-------------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 15 +++----- 3 files changed, 22 insertions(+), 43 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7817fc4959..becf9c842b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -148,8 +148,7 @@ module MOM_diagnostics integer :: id_drho_dT = -1, id_drho_dS = -1 integer :: id_h_pre_sync = -1 !>@} - !> The control structure for calculating wave speed. - type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() + type(wave_speed_CS) :: wave_speed !< Wave speed control struct type(p3d) :: var_ptr(MAX_FIELDS_) !< pointers to variables used in the calculation !! of time derivatives @@ -735,7 +734,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0)) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) if (CS%id_cg1>0) call post_data(CS%id_cg1, CS%cg1, CS%diag) if (CS%id_Rd1>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) @@ -775,12 +774,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if ((CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then if (CS%id_p_ebt>0) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth, modal_structure=CS%p_ebt) call post_data(CS%id_p_ebt, CS%p_ebt, CS%diag) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth) endif @@ -1951,10 +1950,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0) .or. & (CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then - call wave_speed_init(CS%wave_speed_CSp, remap_answers_2018=remap_answers_2018, & + call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) -!### call wave_speed_init(CS%wave_speed_CSp, remap_answers_2018=remap_answers_2018) +!### call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018) call safe_alloc_ptr(CS%cg1,isd,ied,jsd,jed) if (CS%id_Rd1>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) if (CS%id_Rd_ebt>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 833e7d8165..acec868561 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -63,7 +63,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed [L T-1 ~> m s-1] - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + 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 computational domain. logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent @@ -119,7 +119,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ 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, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() 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 @@ -147,8 +146,6 @@ 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. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & - "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 @@ -169,7 +166,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ enddo ; enddo ; enddo endif - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) @@ -196,7 +192,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. min_h_frac = tol_Hfrac / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S,tv,& +!$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, & @@ -229,12 +225,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! 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)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + 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)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + 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 @@ -640,7 +636,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, pointer :: CS !< Control structure for MOM_wave_speed + 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. @@ -726,11 +722,6 @@ 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. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & - "Module must be initialized before it is used.") - endif - if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -1171,7 +1162,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, & better_speed_est, min_speed, wave_speed_tol) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + 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. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over @@ -1194,12 +1185,6 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de # include "version_variable.h" character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "wave_speed_init called with an "// & - "associated control structure.") - return - else ; allocate(CS) ; endif - ! Write all relevant parameters to the model log. call log_version(mdl, version) @@ -1214,7 +1199,8 @@ 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, & better_speed_est, min_speed, wave_speed_tol) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + 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 !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over @@ -1233,9 +1219,6 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] - if (.not.associated(CS)) call MOM_error(FATAL, & - "wave_speed_set_param called with an associated control structure.") - 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 if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9a0e0c86ea..5902f98b56 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -152,7 +152,7 @@ module MOM_lateral_mixing_coeffs !! timing of diagnostic output. !>@} - type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() !< Wave speed control structure + type(wave_speed_CS) :: wave_speed !< Wave speed control structure type(group_pass_type) :: pass_cg1 !< For group halo pass logical :: debug !< If true, write out checksums of data for debugging end type VarMix_CS @@ -224,16 +224,16 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then ! Both resolution fn and vertical structure are using EBT - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, modal_structure=CS%ebt_struct) else ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, modal_structure=CS%ebt_struct, & use_ebt_mode=.true.) - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) endif call pass_var(CS%ebt_struct, G%Domain) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) endif call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) @@ -1527,7 +1527,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& "starting point for iterations.", default=.true.) - call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, & + call wave_speed_init(CS%wave_speed, use_ebt_mode=CS%Resoln_use_ebt, & mono_N2_depth=N2_filter_depth, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) @@ -1634,9 +1634,6 @@ subroutine VarMix_end(CS) DEALLOC_(CS%KH_u_QG) DEALLOC_(CS%KH_v_QG) endif - - if (CS%calculate_cg1) deallocate(CS%wave_speed_CSp) - end subroutine VarMix_end !> \namespace mom_lateral_mixing_coeffs From 7a631304f512d29153d799642f25ce38c6daad2d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 20 Oct 2021 12:24:06 -0400 Subject: [PATCH 18/29] MOM_restart_cs pointer removal * Most `MOM_restart_CS` instances changed from pointers to locals * `MOM_restart_CS` removed from unsplit dyncore subroutines * `restart_CSp` renamed to `restart_CS` in many functions --- src/core/MOM.F90 | 8 +- src/core/MOM_barotropic.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 10 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +- src/core/MOM_open_boundary.F90 | 38 ++--- src/framework/MOM_restart.F90 | 161 +++++------------- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- .../MOM_state_initialization.F90 | 8 +- src/ocean_data_assim/MOM_oda_incupd.F90 | 39 ++--- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 4 +- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_CFC_cap.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/MOM_tracer_registry.F90 | 9 +- src/tracer/RGC_tracer.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/nw2_tracers.F90 | 2 +- src/tracer/oil_tracer.F90 | 2 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 2 +- 32 files changed, 118 insertions(+), 223 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1adcbec3aa..e1927da1f0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2350,10 +2350,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%dyn_split_RK2_CSp, restart_CSp, CS%uh, CS%vh) elseif (CS%use_RK2) then call register_restarts_dyn_unsplit_RK2(HI, GV, param_file, & - CS%dyn_unsplit_RK2_CSp, restart_CSp) + CS%dyn_unsplit_RK2_CSp) else call register_restarts_dyn_unsplit(HI, GV, param_file, & - CS%dyn_unsplit_CSp, restart_CSp) + CS%dyn_unsplit_CSp) endif ! This subroutine calls user-specified tracer registration routines. @@ -2661,13 +2661,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & - param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & + param_file, diag, CS%dyn_unsplit_RK2_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & - param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & + param_file, diag, CS%dyn_unsplit_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cf52bd3a89..6a64b84234 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4253,7 +4253,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, !! output. type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set in register_barotropic_restarts. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the @@ -5013,7 +5013,7 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(barotropic_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd(3) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index ded91709f6..9961f712d9 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1160,7 +1160,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & @@ -1250,7 +1250,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(param_file_type), intent(in) :: param_file !< parameter file for parsing type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct real, intent(in) :: dt !< time step [T ~> s] type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for !! budget analysis diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 1d1a2b11b8..6e2dfaad31 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -67,8 +67,6 @@ module MOM_dynamics_unsplit use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, MOM_restart_CS use MOM_time_manager, only : time_type, real_to_time, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -509,16 +507,14 @@ end subroutine step_MOM_dyn_unsplit !! !! All variables registered here should have the ability to be recreated if they are not present !! in a restart file. -subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) +subroutine register_restarts_dyn_unsplit(HI, GV, param_file, 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(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - ! Local arguments character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -549,7 +545,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -568,8 +564,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! regulate diagnostic output. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the various !! accelerations in the momentum equations, which can be used !! for later derived diagnostics, like energy budgets. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 554c6fb2ed..4cbedafd6f 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -66,8 +66,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_error_handler, only : MOM_set_verbosity use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, MOM_restart_CS use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -454,15 +452,13 @@ end subroutine step_MOM_dyn_unsplit_RK2 !! !! All variables registered here should have the ability to be recreated if they are not present !! in a restart file. -subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) +subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, 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(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. ! This subroutine sets up any auxiliary restart variables that are specific ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. @@ -497,7 +493,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -513,8 +509,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! regulate diagnostic output. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit_RK2. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart - !! control structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the !! various accelerations in the momentum equations, which can !! be used for later derived diagnostics, like energy budgets. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1601d6dd56..ed885b9574 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1786,13 +1786,13 @@ end subroutine parse_segment_param_real !> Initialize open boundary control structure and do any necessary rescaling of OBC !! fields that have been read from a restart file. -subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) +subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Container for vertical grid information type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + type(MOM_restart_CS), intent(in) :: restart_CS !< Restart structure, data intent(inout) ! Local variables real :: vel2_rescale ! A rescaling factor for squared velocities from the representation in @@ -1830,12 +1830,12 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) ! if ( OBC%radiation_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & ! ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then ! vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) -! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CSp)) then +! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CS)) then ! do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ! OBC%rx_normal(I,j,k) = vel_rescale * OBC%rx_normal(I,j,k) ! enddo ; enddo ; enddo ! endif -! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CSp)) then +! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CS)) then ! do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ! OBC%ry_normal(i,J,k) = vel_rescale * OBC%ry_normal(i,J,k) ! enddo ; enddo ; enddo @@ -1846,17 +1846,17 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) if ( OBC%oblique_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then vel2_rescale = (US%m_to_L * US%s_to_T_restart)**2 / (US%m_to_L_restart * US%s_to_T)**2 - if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CSp)) then + if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CS)) then do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB OBC%rx_oblique(I,j,k) = vel2_rescale * OBC%rx_oblique(I,j,k) enddo ; enddo ; enddo endif - if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CSp)) then + if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CS)) then do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied OBC%ry_oblique(i,J,k) = vel2_rescale * OBC%ry_oblique(i,J,k) enddo ; enddo ; enddo endif - if (query_initialized(OBC%cff_normal, "cff_normal", restart_CSp)) then + if (query_initialized(OBC%cff_normal, "cff_normal", restart_CS)) then do k=1,nz ; do J=JsdB,JedB ; do I=IsdB,IedB OBC%cff_normal(I,J,k) = vel2_rescale * OBC%cff_normal(I,J,k) enddo ; enddo ; enddo @@ -4927,14 +4927,14 @@ subroutine flood_fill2(G, color, cin, cout, cland) end subroutine flood_fill2 !> Register OBC segment data for restarts -subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart_CSp, & +subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart_CS, & use_temperature) type(hor_index_type), intent(in) :: HI !< Horizontal indices type(verticalGrid_type), pointer :: GV !< Container for vertical grid information type(ocean_OBC_type), pointer :: OBC !< OBC data structure, data intent(inout) type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables type(vardesc) :: vd(2) @@ -4966,7 +4966,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart vd(1) = var_desc("rx_normal", "m s-1", "Normal Phase Speed for EW radiation OBCs", 'u', 'L') vd(2) = var_desc("ry_normal", "m s-1", "Normal Phase Speed for NS radiation OBCs", 'v', 'L') call register_restart_pair(OBC%rx_normal, OBC%ry_normal, vd(1), vd(2), & - .false., restart_CSp) + .false., restart_CS) endif if (OBC%oblique_BCs_exist_globally) then @@ -4976,11 +4976,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart vd(1) = var_desc("rx_oblique", "m2 s-2", "Radiation Speed Squared for EW oblique OBCs", 'u', 'L') vd(2) = var_desc("ry_oblique", "m2 s-2", "Radiation Speed Squared for NS oblique OBCs", 'v', 'L') call register_restart_pair(OBC%rx_oblique, OBC%ry_oblique, vd(1), vd(2), & - .false., restart_CSp) + .false., restart_CS) allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("cff_normal", "m2 s-2", "denominator for oblique OBCs", 'q', 'L') - call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CSp) + call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CS) endif if (Reg%ntr == 0) return @@ -5006,11 +5006,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (modulo(HI%turns, 2) /= 0) then write(mesg,'("tres_y_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for NS OBCs",'v','L') - call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CS) else write(mesg,'("tres_x_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for EW OBCs",'u','L') - call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CS) endif endif enddo @@ -5022,11 +5022,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (modulo(HI%turns, 2) /= 0) then write(mesg,'("tres_x_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for EW OBCs",'u','L') - call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CS) else write(mesg,'("tres_y_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for NS OBCs",'v','L') - call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CS) endif endif enddo @@ -5433,14 +5433,14 @@ end subroutine rotate_OBC_segment_config !> Initialize the segments and field-related data of a rotated OBC. -subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) +subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) type(ocean_OBC_type), pointer, intent(in) :: OBC_in !< OBC on input map type(ocean_grid_type), intent(in) :: G !< Rotated grid metric type(verticalGrid_type), intent(in) :: GV !< Vertical grid type(unit_scale_type), intent(in) :: US !< Unit scaling type(param_file_type), intent(in) :: param_file !< Input parameters type(thermo_var_ptrs), intent(inout) :: tv !< Tracer fields - type(MOM_restart_CS), pointer, intent(in) :: restart_CSp !< Restart CS + type(MOM_restart_CS), intent(in) :: restart_CS !< Restart CS type(ocean_OBC_type), pointer, intent(inout) :: OBC !< Rotated OBC logical :: use_temperature @@ -5457,7 +5457,7 @@ subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) if (use_temperature) & call fill_temp_salt_segments(G, GV, OBC, tv) - call open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) + call open_boundary_init(G, GV, US, param_file, OBC, restart_CS) end subroutine rotate_OBC_init diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 5d81db10a3..019cfe135c 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -137,7 +137,7 @@ module MOM_restart subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) character(*), intent(in) :: field_name !< Name of restart field that is no longer in use character(*), intent(in) :: replacement_name !< Name of replacement restart field, if applicable - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct CS%num_obsolete_vars = CS%num_obsolete_vars+1 CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name @@ -151,10 +151,7 @@ subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) 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), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -184,10 +181,7 @@ subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS) 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), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -217,10 +211,7 @@ subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS) 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), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -249,10 +240,7 @@ subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS) 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), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -281,10 +269,7 @@ subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS) 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), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -316,7 +301,7 @@ subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, & 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), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -338,7 +323,7 @@ subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, & 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), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -360,7 +345,7 @@ subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, & 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), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -384,7 +369,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units 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. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -393,10 +378,6 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_4d: Module must be initialized before "//& - "it is used to register "//trim(name)) - call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & @@ -414,7 +395,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units 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. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -423,10 +404,6 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_3d: Module must be initialized before "//& - "it is used to register "//trim(name)) - call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & @@ -444,7 +421,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units 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. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -454,9 +431,6 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd character(len=8) :: Zgrid - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_2d: Module must be initialized before "//& - "it is used to register "//trim(name)) zgrid = '1' ; if (present(z_grid)) zgrid = z_grid call lock_check(CS, name=name) @@ -475,7 +449,7 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units 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. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, '1' if absent @@ -485,9 +459,6 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd character(len=8) :: hgrid - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_3d: Module must be initialized before "//& - "it is used to register "//trim(name)) hgrid = '1' ; if (present(hor_grid)) hgrid = hor_grid call lock_check(CS, name=name) @@ -506,17 +477,13 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units 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. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_0d: Module must be initialized before "//& - "it is used to register "//trim(name)) - call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid='1', & @@ -530,14 +497,12 @@ end subroutine register_restart_field_0d !> query_initialized_name determines whether a named field has been successfully !! read from a restart file yet. function query_initialized_name(name, CS) result(query_initialized) - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + 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 integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -563,13 +528,11 @@ 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 - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -588,13 +551,11 @@ 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 - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -614,13 +575,11 @@ end function query_initialized_1d 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 - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -640,13 +599,11 @@ end function query_initialized_2d 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 - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -666,13 +623,11 @@ end function query_initialized_3d 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 - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -692,14 +647,12 @@ end function query_initialized_4d !! 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 !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + 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 integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -726,14 +679,12 @@ end function query_initialized_0d_name function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + 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 integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -760,14 +711,12 @@ end function query_initialized_1d_name function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + 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 integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -794,14 +743,12 @@ end function query_initialized_2d_name function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + 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 integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -828,14 +775,12 @@ end function query_initialized_3d_name function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + 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 integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -863,8 +808,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ !! are to be written type(time_type), intent(in) :: time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct logical, optional, intent(in) :: time_stamped !< If present and true, add time-stamp !! to the restart file names character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile @@ -906,8 +850,6 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ turns = CS%turns - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "save_restart: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) ! With parallel read & write, it is possible to disable the following... @@ -1068,8 +1010,7 @@ subroutine restore_state(filename, directory, day, G, CS) character(len=*), intent(in) :: directory !< The directory in which to find restart files type(time_type), intent(out) :: day !< The time of the restarted run type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct ! Local variables character(len=200) :: filepath ! The path (dir/file) to the file being opened. @@ -1097,8 +1038,6 @@ subroutine restore_state(filename, directory, day, G, CS) 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. - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "restore_state: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) ! Get NetCDF ids for all of the restart files. @@ -1285,23 +1224,18 @@ function restart_files_exist(filename, directory, G, CS) !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: restart_files_exist !< The function result, which indicates whether !! any of the explicitly or automatically named !! restart files exist in directory integer :: num_files - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "restart_files_exist: Module must be initialized before it is used.") - if ((LEN_TRIM(filename) == 1) .and. (filename(1:1) == 'F')) then num_files = get_num_restart_files('r', directory, G, CS) else num_files = get_num_restart_files(filename, directory, G, CS) endif restart_files_exist = (num_files > 0) - end function restart_files_exist !> determine_is_new_run determines from the value of filename and the existence @@ -1312,14 +1246,11 @@ function determine_is_new_run(filename, directory, G, CS) result(is_new_run) !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct logical :: is_new_run !< The function result, which indicates whether !! this is a new run, based on the value of !! filename and whether restart files exist - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "determine_is_new_run: Module must be initialized before it is used.") if (LEN_TRIM(filename) > 1) then CS%new_run = .false. elseif (LEN_TRIM(filename) == 0) then @@ -1339,13 +1270,11 @@ end function determine_is_new_run !> is_new_run returns whether this is going to be a new run based on the !! information stored in CS by a previous call to determine_is_new_run. function is_new_run(CS) - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + logical :: is_new_run !< The function result, which had been stored in CS during !! a previous call to determine_is_new_run - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "is_new_run: Module must be initialized before it is used.") if (.not.CS%new_run_set) call MOM_error(FATAL, "MOM_restart " // & "determine_is_new_run must be called for a restart file before is_new_run.") @@ -1360,8 +1289,8 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + type(file_type), dimension(:), & optional, intent(out) :: IO_handles !< The I/O handles of all opened files character(len=*), dimension(:), & @@ -1388,9 +1317,6 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, character(len=32) :: filename_appendix = '' ! Filename appendix for ensemble runs character(len=80) :: restartname - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "open_restart_units: Module must be initialized before it is used.") - ! Get NetCDF ids for all of the restart files. num_restart = 0 ; nf = 0 ; start_char = 1 do while (start_char <= len_trim(filename) ) @@ -1496,16 +1422,13 @@ function get_num_restart_files(filenames, directory, G, CS, file_paths) result(n !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct character(len=*), dimension(:), & optional, intent(out) :: file_paths !< The full paths to the restart files. + integer :: num_files !< The function result, the number of files (both automatically named !! restart files and others explicitly in filename) that have been opened - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "get_num_restart_files: Module must be initialized before it is used.") - ! This call uses open_restart_units without the optional arguments needed to actually ! open the files to determine the number of restart files. num_files = open_restart_units(filenames, directory, G, CS, file_paths=file_paths) @@ -1654,7 +1577,7 @@ subroutine restart_end(CS) end subroutine restart_end subroutine restart_error(CS) - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct character(len=16) :: num ! String for error messages diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 08c50fa09a..df2e801613 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -228,7 +228,7 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 9b9fdac145..6a4d4195d5 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -136,8 +136,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), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct 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. @@ -653,8 +652,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, & PF, oda_incupd_CSp, restart_CS, Time) endif - - end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. @@ -2060,8 +2057,7 @@ 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), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in !! overrides any value set for !Time. diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 91210a328d..ab3621296f 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -92,14 +92,12 @@ module MOM_oda_incupd !> This subroutine defined the control structure of module and register !the time counter to full update in restart subroutine initialize_oda_incupd_fixed( G, GV, US, CS, restart_CS) - - type(ocean_grid_type), intent(in) :: G !< The ocean's 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(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module (in/out). - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - + type(ocean_grid_type), intent(in) :: G !< The ocean's 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(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -116,28 +114,23 @@ subroutine initialize_oda_incupd_fixed( G, GV, US, CS, restart_CS) ! register ncount in restart call register_restart_field(CS%ncount, "oda_incupd_ncount", .false., restart_CS,& "Number of inc. update already done", "N/A") - - end subroutine initialize_oda_incupd_fixed !> This subroutine defined the number of time step for full update, stores the layer pressure !! increments and initialize remap structure. subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, restart_CS) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, intent(in) :: nz_data !< The total number of incr. input layers. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. - type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module (in/out). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: nz_data !< The total number of incr. input layers. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The ODA h !! [H ~> m or kg m-2]. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. - + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -242,8 +235,6 @@ subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, res ! Call the constructor for remapping control structure call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & answers_2018=.false.) - - end subroutine initialize_oda_incupd diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 551caa625e..e4f18e75d7 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1022,7 +1022,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) 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), pointer :: restart_CS !< Restart control structure for MOM_MEKE. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this @@ -1379,7 +1379,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_GMECoeff, MEKE_KHCoeff, MEKE_viscCoeff_Ku, MEKE_viscCoeff_Au diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fd420a261f..d0bdff8578 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -2080,7 +2080,7 @@ end subroutine PPM_limit_pos ! 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), pointer :: restart_CS !< A pointer to the restart control structure. +! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! ! This subroutine is not currently in use!! diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 9cfbf8f5f8..bb37245c5b 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -795,7 +795,7 @@ 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! Local variables real :: H_rescale ! A rescaling factor for thicknesses from the representation in @@ -940,7 +940,7 @@ subroutine mixedlayer_restrat_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 !< Parameter file to parse type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd logical :: mixedlayer_restrat_init diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1cf3b5ddc9..902c22240b 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1807,7 +1807,7 @@ subroutine set_visc_register_restarts(HI, GV, 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), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1898,7 +1898,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! related fields. Allocated here. type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 62181fe9ea..2d18b7c907 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -65,7 +65,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) 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), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 144b21e29a..013b04a5b3 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -71,7 +71,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(ISOMIP_tracer_CS), pointer :: CS ! advection_xy ; endif - if (present(restart_CS)) then ; if (associated(restart_CS)) then + if (present(restart_CS)) then ! Register this tracer to be read from and written to restart files. mand = .true. ; if (present(mandatory)) mand = mandatory call register_restart_field(tr_ptr, Tr%name, mand, restart_CS, & longname=Tr%longname, units=Tr%units) - endif ; endif - + endif end subroutine register_tracer diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 274f85d435..244eebb2bc 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -72,7 +72,7 @@ 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), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct character(len=80) :: name, longname ! This include declares and sets the variable "version". diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4d05d43fd9..d6d1ac25fe 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -71,7 +71,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 3aaa51b301..bc5d19b4fb 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -69,7 +69,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a26c967eae..9a3ca019bd 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -72,7 +72,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), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables ! This include declares and sets the variable "version". diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index f299febfa8..b6bd212a37 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -56,7 +56,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(dyed_obc_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), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index ffe4f9df72..60d9c02aa0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -76,7 +76,7 @@ function register_ideal_age_tracer(HI, GV, 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index 4578a422dc..fcb9f3e854 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -51,7 +51,7 @@ logical function register_nw2_tracers(HI, GV, 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index fcc0de23d8..0ebf9dcfc9 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -78,7 +78,7 @@ function register_oil_tracer(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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "oil_tracer" ! This module's name. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index cd1ee41ebd..5ba61923ed 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -62,7 +62,7 @@ function register_pseudo_salt_tracer(HI, GV, 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 3eb83a79c5..b58e45b366 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -60,7 +60,7 @@ function USER_register_tracer_example(HI, GV, 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), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 277c0423aa..4d44e580e0 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -411,7 +411,7 @@ subroutine register_ctrl_forcing_restarts(G, param_file, CS, restart_CS) !! parameter values. type(ctrl_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct logical :: controlled, use_temperature character (len=8) :: period_str From 09a990c3c097391e693ad2694f6fcb22627c128c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 26 Oct 2021 13:44:11 -0400 Subject: [PATCH 19/29] Barotropic CS pointer removal * Instances of `barotropic_CS` pointers changed to locals * `barotropic_CSp` removed from MOM module, as it was unused * `frhat[uv]1` converted to allocatable * `BT_OBC` field pointers to allocatable --- src/core/MOM.F90 | 2 - src/core/MOM_barotropic.F90 | 85 +++++++++++------------------ src/core/MOM_dynamics_split_RK2.F90 | 5 +- 3 files changed, 34 insertions(+), 58 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e1927da1f0..32630af467 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -359,8 +359,6 @@ module MOM !< Pointer to the control structure for the MEKE updates type(VarMix_CS) :: VarMix !< Control structure for the variable mixing module - type(Barotropic_CS), pointer :: Barotropic_CSp => NULL() - !< Pointer to the control structure for the barotropic module type(tracer_registry_type), pointer :: tracer_Reg => NULL() !< Pointer to the MOM tracer registry type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6a64b84234..f49ce0073b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -6,7 +6,7 @@ module MOM_barotropic use MOM_debugging, only : hchksum, uvchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field -use MOM_diag_mediator, only : safe_alloc_ptr, diag_ctrl, enable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averaging use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain use MOM_domains, only : To_All, Scalar_Pair, AGRID, CORNER, MOM_domain_type use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type @@ -67,22 +67,22 @@ module MOM_barotropic !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type - real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, - !! as set by the open boundary conditions [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, - !! as set by the open boundary conditions [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain - !! at a u-point with an open boundary condition [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain - !! at a v-point with an open boundary condition [H ~> m or kg m-2]. + real, allocatable :: Cg_u(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, allocatable :: Cg_v(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, allocatable :: H_u(:,:) !< The total thickness at the u-points [H ~> m or kg m-2]. + real, allocatable :: H_v(:,:) !< The total thickness at the v-points [H ~> m or kg m-2]. + real, allocatable :: uhbt(:,:) !< The zonal barotropic thickness fluxes specified + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, allocatable :: vhbt(:,:) !< The meridional barotropic thickness fluxes specified + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, allocatable :: ubt_outer(:,:) !< The zonal velocities just outside the domain, + !! as set by the open boundary conditions [L T-1 ~> m s-1]. + real, allocatable :: vbt_outer(:,:) !< The meridional velocities just outside the domain, + !! as set by the open boundary conditions [L T-1 ~> m s-1]. + real, allocatable :: eta_outer_u(:,:) !< The surface height outside of the domain + !! at a u-point with an open boundary condition [H ~> m or kg m-2]. + real, allocatable :: eta_outer_v(:,:) !< The surface height outside of the domain + !! at a v-point with an open boundary condition [H ~> m or kg m-2]. logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point. logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point. !>@{ Index ranges for the open boundary conditions @@ -149,8 +149,8 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1]. - real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. - real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. + real, allocatable :: frhatu1(:,:,:) !< Predictor step values of frhatu stored for diagnostics. + real, allocatable :: frhatv1(:,:,:) !< Predictor step values of frhatv stored for diagnostics. type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. @@ -451,8 +451,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - type(barotropic_CS), pointer :: CS !< The control structure returned by a - !! previous call to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: visc_rem_u !< Both the fraction of the momentum !! originally in a layer that remains after a time-step of !! viscosity, and the fraction of a time-step's worth of a @@ -695,8 +694,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, integer :: ioff, joff integer :: l_seg - if (.not.associated(CS)) call MOM_error(FATAL, & - "btstep: Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return 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 @@ -2718,7 +2715,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) 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(barotropic_CS), pointer :: CS !< Barotropic control structure. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: pbce !< The baroclinic pressure @@ -2767,8 +2764,6 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) character(len=200) :: mesg integer :: i, j, k, is, ie, js, je, nz - if (.not.associated(CS)) call MOM_error(FATAL, & - "set_dtbt: Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed @@ -3044,7 +3039,7 @@ end subroutine apply_velocity_OBCs !! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, & integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type. + type(ocean_OBC_type), intent(inout) :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -3263,8 +3258,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) 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]. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -3304,8 +3298,6 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! This section interpolates thicknesses onto u & v grid points with the ! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-). - if (.not.associated(CS)) call MOM_error(FATAL, & - "btcalc: Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return use_default = .false. @@ -4090,8 +4082,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) 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(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. + type(barotropic_CS), intent(in) :: CS !< Barotropic control struct integer, intent(in) :: halo !< The halo size to use, default = 1. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly @@ -4185,8 +4176,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) !! fluxes (and update the slowly varying part of eta_cor) !! (.true.) or whether to incrementally update the !! corrective fluxes. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous call - !! to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct ! Local variables real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses [H ~> m or kg m-2]. @@ -4196,8 +4186,6 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) ! thicknesses [H ~> m or kg m-2]. integer :: is, ie, js, je, nz, i, j, k - if (.not.associated(CS)) call MOM_error(FATAL, "bt_mass_source: "// & - "Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -4251,8 +4239,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module - !! that is set in register_barotropic_restarts. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. @@ -4880,8 +4867,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, & 'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) - if (CS%id_frhatu1 > 0) call safe_alloc_ptr(CS%frhatu1, IsdB,IedB,jsd,jed,nz) - if (CS%id_frhatv1 > 0) call safe_alloc_ptr(CS%frhatv1, isd,ied,JsdB,JedB,nz) + if (CS%id_frhatu1 > 0) allocate(CS%frhatu1(IsdB:IedB,jsd:jed,nz), source=0.) + if (CS%id_frhatv1 > 0) allocate(CS%frhatv1(isd:ied,JsdB:JedB,nz), source=0.) if (.NOT.query_initialized(CS%ubtav,"ubtav",restart_CS) .or. & .NOT.query_initialized(CS%vbtav,"vbtav",restart_CS)) then @@ -4961,7 +4948,7 @@ end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) - type(barotropic_CS), pointer :: CS !< Control structure for this module + type(barotropic_CS), intent(in) :: CS !< Barotropic control struct type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged !! over a baroclinic timestep [L T-1 ~> m s-1] @@ -4997,8 +4984,8 @@ subroutine barotropic_end(CS) DEALLOC_(CS%eta_cor) DEALLOC_(CS%frhatu) ; DEALLOC_(CS%frhatv) - if (associated(CS%frhatu1)) deallocate(CS%frhatu1) - if (associated(CS%frhatv1)) deallocate(CS%frhatv1) + if (allocated(CS%frhatu1)) deallocate(CS%frhatu1) + if (allocated(CS%frhatv1)) deallocate(CS%frhatv1) call deallocate_MOM_domain(CS%BT_domain) ! Allocated in restart registration, prior to timestep initialization @@ -5010,8 +4997,7 @@ end subroutine barotropic_end subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(barotropic_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct @@ -5023,13 +5009,6 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB - if (associated(CS)) then - call MOM_error(WARNING, "register_barotropic_restarts called with an associated "// & - "control structure.") - return - endif - allocate(CS) - call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & "If true, adjust the initial conditions for the "//& "barotropic solver to the values from the layered "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 9961f712d9..1a8e68bc8d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -206,12 +206,12 @@ module MOM_dynamics_split_RK2 type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() - !> A pointer to the barotropic stepping control structure - type(barotropic_CS), pointer :: barotropic_CSp => NULL() !> A pointer to a structure containing interface height diffusivities type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() + !> A pointer to the barotropic stepping control structure + type(barotropic_CS) :: barotropic_CSp !> A pointer to the tidal forcing control structure type(tidal_forcing_CS) :: tides_CSp !> A pointer to the ALE control structure. @@ -1689,7 +1689,6 @@ subroutine end_dyn_split_RK2(CS) type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure call barotropic_end(CS%barotropic_CSp) - deallocate(CS%barotropic_CSp) call vertvisc_end(CS%vertvisc_CSp) deallocate(CS%vertvisc_CSp) From 8632fee081541b385288f0c9c4c1e18148ee476f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 27 Oct 2021 05:31:05 -0400 Subject: [PATCH 20/29] Wave structure CS pointer * `wave_structure_CS` instances changed from pointer to local * T and S aliases to `tv` in `MOM_wave_structure` removed * `wave_structure_CSp` renamed to `wave_struct` in internal tides --- src/diagnostics/MOM_wave_structure.F90 | 28 +++++-------------- .../lateral/MOM_internal_tides.F90 | 15 +++++----- 2 files changed, 14 insertions(+), 29 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index cf4c518889..3ae4f218d4 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -102,8 +102,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! 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), pointer :: CS !< The control structure returned by a - !! previous call to wave_structure_init. + 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 @@ -145,7 +144,6 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: I_Hnew !< The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum !< The sum of density diffrences across interfaces times thicknesses [R Z ~> kg m-2] real, parameter :: tol1 = 0.0001, tol2 = 0.001 - real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() 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)) @@ -193,18 +191,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke I_a_int = 1/a_int - !if (present(CS)) then - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_structure: "// & - "Module must be initialized before it is used.") - !endif - 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)) - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 !if (CS%debug) call chksum0(g_Rho0, "g/rho0 in wave struct", & @@ -242,12 +234,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! 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)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + 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)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + 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 @@ -727,8 +719,8 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + 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. @@ -736,12 +728,6 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - if (associated(CS)) then - call MOM_error(WARNING, "wave_structure_init called with an "// & - "associated control structure.") - return - else ; allocate(CS) ; endif - 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, & diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index d0bdff8578..eb7d3a6340 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -116,8 +116,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), pointer :: wave_structure_CSp => NULL() - !< A pointer to the wave_structure module control structure + type(wave_structure_CS) :: wave_struct !< Wave structure control struct !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles @@ -404,13 +403,13 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & 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_structure_CSp, tot_En_mode(:,:,fr,m), full_halos=.true.) + CS%wave_struct, tot_En_mode(:,:,fr,m), full_halos=.true.) ! Pick out 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_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + 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)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -448,7 +447,7 @@ 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_structure_CSp%num_intfaces(i,j) + 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 @@ -2558,7 +2557,7 @@ 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_structure_CSp) + call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_struct) end subroutine internal_tides_init From b1765713fd979c378298a1a4a0995a72438a6080 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 27 Oct 2021 11:32:04 -0400 Subject: [PATCH 21/29] ALE sponge pointer removal (partial) * Some instances of `ALE_sponge_CS` declared as local * Redfined many allocatable arrays declared as pointers Much of this module was left unmodified, due to a lot of decision making based on the associated status of the CS. --- .../vertical/MOM_ALE_sponge.F90 | 55 ++++++++----------- 1 file changed, 22 insertions(+), 33 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 4d179e2bfb..472ee21e36 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -69,7 +69,6 @@ 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 :: mask_in => NULL() !< pointer to the data mask. real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data. real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid. end type p3d @@ -79,7 +78,6 @@ 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 :: mask_in => NULL()!< pointer to the data mask. real, dimension(:,:), pointer :: p => NULL() !< pointer the data. real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. end type p2d @@ -94,16 +92,16 @@ module MOM_ALE_sponge integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field logical :: sponge_uv !< Control whether u and v are included in sponge - integer, pointer :: col_i(:) => NULL() !< Array of the i-indices of each tracer column being damped. - integer, pointer :: col_j(:) => NULL() !< Array of the j-indices of each tracer column being damped. - integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indices of each u-column being damped. - integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indices of each u-column being damped. - integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indices of each v-column being damped. - integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indices of each v-column being damped. + integer, allocatable :: col_i(:) !< Array of the i-indices of each tracer column being damped + integer, allocatable :: col_j(:) !< Array of the j-indices of each tracer column being damped + integer, allocatable :: col_i_u(:) !< Array of the i-indices of each u-column being damped + integer, allocatable :: col_j_u(:) !< Array of the j-indices of each u-column being damped + integer, allocatable :: col_i_v(:) !< Array of the i-indices of each v-column being damped + integer, allocatable :: col_j_v(:) !< Array of the j-indices of each v-column being damped - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [T-1 ~> s-1]. - real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [T-1 ~> s-1]. - real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column [T-1 ~> s-1]. + real, allocatable :: Iresttime_col(:) !< The inverse restoring time of each tracer column [T-1 ~> s-1] + real, allocatable :: Iresttime_col_u(:) !< The inverse restoring time of each u-column [T-1 ~> s-1] + real, allocatable :: Iresttime_col_v(:) !< The inverse restoring time of each v-column [T-1 ~> s-1] type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -366,15 +364,10 @@ end subroutine initialize_ALE_sponge_fixed !> Return the number of layers in the data with a fixed ALE sponge, or 0 if there are !! no sponge columns on this PE. function get_ALE_sponge_nz_data(CS) - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for the ALE_sponge module. + type(ALE_sponge_CS), intent(in) :: CS !< ALE sponge control struct integer :: get_ALE_sponge_nz_data !< The number of layers in the fixed sponge data. - if (associated(CS)) then - get_ALE_sponge_nz_data = CS%nz_data - else - get_ALE_sponge_nz_data = 0 - endif + get_ALE_sponge_nz_data = CS%nz_data end function get_ALE_sponge_nz_data !> Return the thicknesses used for the data with a fixed ALE sponge @@ -600,11 +593,9 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS, US) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure + type(ALE_sponge_CS), intent(inout) :: CS !< ALE sponge control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - if (.not.associated(CS)) return - CS%diag => diag CS%id_sp_tendency(1) = -1 @@ -1277,8 +1268,7 @@ end subroutine rotate_ALE_sponge ! after rotation. This function is part of a temporary solution until ! something more robust is developed. subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) - type(ALE_sponge_CS), pointer :: sponge !< A pointer to the control structure for this module - !! that is set by a previous call to initialize_ALE_sponge. + type(ALE_sponge_CS), intent(inout) :: sponge !< ALE sponge control struct real, dimension(:,:,:), & target, intent(in) :: p_old !< The previous array of target values type(ocean_grid_type), intent(in) :: G !< The updated ocean grid structure @@ -1291,7 +1281,6 @@ subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) do n=1,sponge%fldno if (associated(sponge%var(n)%p, p_old)) sponge%var(n)%p => p_new enddo - end subroutine update_ALE_sponge_field @@ -1306,16 +1295,16 @@ subroutine ALE_sponge_end(CS) if (.not.associated(CS)) return - if (associated(CS%col_i)) deallocate(CS%col_i) - if (associated(CS%col_i_u)) deallocate(CS%col_i_u) - if (associated(CS%col_i_v)) deallocate(CS%col_i_v) - if (associated(CS%col_j)) deallocate(CS%col_j) - if (associated(CS%col_j_u)) deallocate(CS%col_j_u) - if (associated(CS%col_j_v)) deallocate(CS%col_j_v) + if (allocated(CS%col_i)) deallocate(CS%col_i) + if (allocated(CS%col_i_u)) deallocate(CS%col_i_u) + if (allocated(CS%col_i_v)) deallocate(CS%col_i_v) + if (allocated(CS%col_j)) deallocate(CS%col_j) + if (allocated(CS%col_j_u)) deallocate(CS%col_j_u) + if (allocated(CS%col_j_v)) deallocate(CS%col_j_v) - if (associated(CS%Iresttime_col)) deallocate(CS%Iresttime_col) - if (associated(CS%Iresttime_col_u)) deallocate(CS%Iresttime_col_u) - if (associated(CS%Iresttime_col_v)) deallocate(CS%Iresttime_col_v) + if (allocated(CS%Iresttime_col)) deallocate(CS%Iresttime_col) + if (allocated(CS%Iresttime_col_u)) deallocate(CS%Iresttime_col_u) + if (allocated(CS%Iresttime_col_v)) deallocate(CS%Iresttime_col_v) do m=1,CS%fldno if (associated(CS%Ref_val(m)%p)) deallocate(CS%Ref_val(m)%p) From 5b1dd3f96073913ae71bdfd3ac0126d356e1a5dc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 27 Oct 2021 15:38:28 -0400 Subject: [PATCH 22/29] MOM diagnostic pointer removal * diagnostic field pointers changed to allocatables * `safe_alloc_ptr` calls replaced with `allocate()` * Some instances of `diagnostics_CS` passed as type * `diagnostics_CS` in MOM_mod moved to stack --- src/core/MOM.F90 | 3 +- src/diagnostics/MOM_diagnostics.F90 | 307 +++++++++++++--------------- 2 files changed, 147 insertions(+), 163 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 32630af467..027127189d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -385,7 +385,7 @@ module MOM ! Pointers to control structures used for diagnostics type(sum_output_CS), pointer :: sum_output_CSp => NULL() !< Pointer to the globally summed output control structure - type(diagnostics_CS), pointer :: diagnostics_CSp => NULL() + type(diagnostics_CS) :: diagnostics_CSp !< Pointer to the MOM diagnostics control structure type(offline_transport_CS), pointer :: offline_CSp => NULL() !< Pointer to the offline tracer transport control structure @@ -3592,7 +3592,6 @@ subroutine MOM_end(CS) endif call MOM_diagnostics_end(CS%diagnostics_CSp, CS%ADp, CS%CDp) - deallocate(CS%diagnostics_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index becf9c842b..bcee812c73 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -61,55 +61,51 @@ module MOM_diagnostics ! following arrays store diagnostics calculated here and unavailable outside. ! following fields have nz+1 levels. - real, pointer, dimension(:,:,:) :: & - e => NULL(), & !< interface height [Z ~> m] - e_D => NULL() !< interface height above bottom [Z ~> m] + real, allocatable :: e(:,:,:) !< interface height [Z ~> m] + real, allocatable :: e_D(:,:,:) !< interface height above bottom [Z ~> m] ! following fields have nz layers. - real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [L T-2 ~> m s-2] - dv_dt => NULL(), & !< net j-acceleration [L T-2 ~> m s-2] - dh_dt => NULL(), & !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] - p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] - ! hf_du_dt => NULL(), hf_dv_dt => NULL() !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - - real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density - !! coordinates [H ~> m or kg m-2] - real, pointer, dimension(:,:,:) :: uh_Rlay => NULL() !< Zonal transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: vh_Rlay => NULL() !< Meridional transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: uhGM_Rlay => NULL() !< Zonal Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: vhGM_Rlay => NULL() !< Meridional Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: du_dt(:,:,:) !< net i-acceleration [L T-2 ~> m s-2] + real, allocatable :: dv_dt(:,:,:) !< net j-acceleration [L T-2 ~> m s-2] + real, allocatable :: dh_dt(:,:,:) !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] + real, allocatable :: p_ebt(:,:,:) !< Equivalent barotropic modal structure [nondim] + ! real, allocatable :: hf_du_dt(:,:,:), hf_dv_dt(:,:,:) !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. + ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + + real, allocatable :: h_Rlay(:,:,:) !< Layer thicknesses in potential density + !! coordinates [H ~> m or kg m-2] + real, allocatable :: uh_Rlay(:,:,:) !< Zonal transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: vh_Rlay(:,:,:) !< Meridional transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: uhGM_Rlay(:,:,:) !< Zonal Gent-McWilliams transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: vhGM_Rlay(:,:,:) !< Meridional Gent-McWilliams transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] ! following fields are 2-D. - real, pointer, dimension(:,:) :: & - cg1 => NULL(), & !< First baroclinic gravity wave speed [L T-1 ~> m s-1] - Rd1 => NULL(), & !< First baroclinic deformation radius [L ~> m] - cfl_cg1 => NULL(), & !< CFL for first baroclinic gravity wave speed [nondim] - cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed [nondim] - cfl_cg1_y => NULL() !< j-component of CFL for first baroclinic gravity wave speed [nondim] + real, allocatable :: cg1(:,:) !< First baroclinic gravity wave speed [L T-1 ~> m s-1] + real, allocatable :: Rd1(:,:) !< First baroclinic deformation radius [L ~> m] + real, allocatable :: cfl_cg1(:,:) !< CFL for first baroclinic gravity wave speed [nondim] + real, allocatable :: cfl_cg1_x(:,:) !< i-component of CFL for first baroclinic gravity wave speed [nondim] + real, allocatable :: cfl_cg1_y(:,:) !< j-component of CFL for first baroclinic gravity wave speed [nondim] ! The following arrays hold diagnostics in the layer-integrated energy budget. - real, pointer, dimension(:,:,:) :: & - KE => NULL(), & !< KE per unit mass [L2 T-2 ~> m2 s-2] - dKE_dt => NULL(), & !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] - PE_to_KE => NULL(), & !< potential energy to KE term [m3 s-3] - KE_BT => NULL(), & !< barotropic contribution to KE term [m3 s-3] - KE_CorAdv => NULL(), & !< KE source from the combined Coriolis and - !! advection terms [H L2 T-3 ~> m3 s-3]. - !! The Coriolis source should be zero, but is not due to truncation - !! errors. There should be near-cancellation of the global integral - !! of this spurious Coriolis source. - KE_adv => NULL(), & !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] - KE_visc => NULL(), & !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] - KE_stress => NULL(), & !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] - KE_horvisc => NULL(), & !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] - KE_dia => NULL() !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE(:,:,:) !< KE per unit mass [L2 T-2 ~> m2 s-2] + real, allocatable :: dKE_dt(:,:,:) !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] + real, allocatable :: PE_to_KE(:,:,:) !< potential energy to KE term [m3 s-3] + real, allocatable :: KE_BT(:,:,:) !< barotropic contribution to KE term [m3 s-3] + real, allocatable :: KE_CorAdv(:,:,:) !< KE source from the combined Coriolis and + !! advection terms [H L2 T-3 ~> m3 s-3]. + !! The Coriolis source should be zero, but is not due to truncation + !! errors. There should be near-cancellation of the global integral + !! of this spurious Coriolis source. + real, allocatable :: KE_adv(:,:,:) !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_visc(:,:,:) !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_stress(:,:,:) !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_horvisc(:,:,:) !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_dia(:,:,:) !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] !>@{ Diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 @@ -384,13 +380,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_uv, uv, CS%diag) endif - if (associated(CS%e)) then + if (allocated(CS%e)) then call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif - if (associated(CS%e_D)) then - if (associated(CS%e)) then + if (allocated(CS%e_D)) then + if (allocated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo @@ -554,9 +550,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) - if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. associated(CS%h_Rlay) .or. & - associated(CS%uh_Rlay) .or. associated(CS%vh_Rlay) .or. & - associated(CS%uhGM_Rlay) .or. associated(CS%vhGM_Rlay)) then + if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. allocated(CS%h_Rlay) .or. & + allocated(CS%uh_Rlay) .or. allocated(CS%vh_Rlay) .or. & + allocated(CS%uhGM_Rlay) .or. allocated(CS%vhGM_Rlay)) then if (associated(tv%eqn_of_state)) then EOSdom(:) = EOS_domain(G%HI, halo=1) @@ -574,7 +570,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rcv, CS%diag) if (CS%id_Rcv > 0) call post_data(CS%id_Rcv, Rcv, CS%diag) - if (associated(CS%h_Rlay)) then + if (allocated(CS%h_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(is,ie,js,je,nz,nkmb,CS,Rcv,h,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -595,7 +591,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h_Rlay > 0) call post_data(CS%id_h_Rlay, CS%h_Rlay, CS%diag) endif - if (associated(CS%uh_Rlay)) then + if (allocated(CS%uh_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CS,GV,uh) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -617,7 +613,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_uh_Rlay > 0) call post_data(CS%id_uh_Rlay, CS%uh_Rlay, CS%diag) endif - if (associated(CS%vh_Rlay)) then + if (allocated(CS%vh_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,nz,nkmb,Rcv,CS,GV,vh) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -638,7 +634,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_vh_Rlay > 0) call post_data(CS%id_vh_Rlay, CS%vh_Rlay, CS%diag) endif - if (associated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then + if (allocated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then k_list = nz/2 !$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CDP,CS,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -659,7 +655,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) endif - if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then + if (allocated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then k_list = nz/2 !$OMP parallel do default(none) shared(is,ie,Jsq,Jeq,nz,nkmb,CS,CDp,Rcv,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -1029,7 +1025,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 enddo ; enddo - if (associated(CS%KE)) then + if (allocated(CS%KE)) then do k=1,nz ; do j=js,je ; do i=is,ie CS%KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 @@ -1041,14 +1037,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (.not.G%symmetric) then - if (associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_BT) .OR. & - associated(CS%KE_CorAdv) .OR. associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. & - associated(CS%KE_horvisc) .OR. associated(CS%KE_dia) ) then + if (allocated(CS%dKE_dt) .OR. allocated(CS%PE_to_KE) .OR. allocated(CS%KE_BT) .OR. & + allocated(CS%KE_CorAdv) .OR. allocated(CS%KE_adv) .OR. allocated(CS%KE_visc) .OR. & + allocated(CS%KE_horvisc) .OR. allocated(CS%KE_dia) ) then call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif endif - if (associated(CS%dKE_dt)) then + if (allocated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k) @@ -1069,7 +1065,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_dKEdt > 0) call post_data(CS%id_dKEdt, CS%dKE_dt, CS%diag) endif - if (associated(CS%PE_to_KE)) then + if (allocated(CS%PE_to_KE)) then 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%PFu(I,j,k) @@ -1087,7 +1083,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, CS%PE_to_KE, CS%diag) endif - if (associated(CS%KE_BT)) then + if (allocated(CS%KE_BT)) then 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%u_accel_bt(I,j,k) @@ -1105,7 +1101,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_BT > 0) call post_data(CS%id_KE_BT, CS%KE_BT, CS%diag) endif - if (associated(CS%KE_CorAdv)) then + if (allocated(CS%KE_CorAdv)) then 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%CAu(I,j,k) @@ -1127,7 +1123,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_Coradv > 0) call post_data(CS%id_KE_Coradv, CS%KE_Coradv, CS%diag) endif - if (associated(CS%KE_adv)) then + if (allocated(CS%KE_adv)) then ! NOTE: All terms in KE_adv are multipled by -1, which can easily produce ! negative zeros and may signal a reproducibility issue over land. ! We resolve this by re-initializing and only evaluating over water points. @@ -1155,7 +1151,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_adv > 0) call post_data(CS%id_KE_adv, CS%KE_adv, CS%diag) endif - if (associated(CS%KE_visc)) then + if (allocated(CS%KE_visc)) then 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(I,j,k) @@ -1173,7 +1169,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) endif - if (associated(CS%KE_stress)) then + if (allocated(CS%KE_stress)) then 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_str(I,j,k) @@ -1191,7 +1187,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_stress > 0) call post_data(CS%id_KE_stress, CS%KE_stress, CS%diag) endif - if (associated(CS%KE_horvisc)) then + if (allocated(CS%KE_horvisc)) then 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%diffu(I,j,k) @@ -1209,7 +1205,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_horvisc > 0) call post_data(CS%id_KE_horvisc, CS%KE_horvisc, CS%diag) endif - if (associated(CS%KE_dia)) then + if (allocated(CS%KE_dia)) then 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_dia(I,j,k) @@ -1239,7 +1235,7 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) !< Time derivative operand real, dimension(lb(1):,lb(2):,:), target :: deriv_ptr !< Time derivative of f_ptr - type(diagnostics_CS), pointer :: CS !< Control structure returned by previous call to + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine registers fields to calculate a diagnostic time derivative. @@ -1249,9 +1245,6 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) integer :: m !< New index of deriv_ptr in CS%deriv integer :: ub(3) !< Upper index bound of f_ptr, based on shape. - if (.not.associated(CS)) call MOM_error(FATAL, & - "register_time_deriv: Module must be initialized before it is used.") - if (CS%num_time_deriv >= MAX_FIELDS_) then call MOM_error(WARNING,"MOM_diagnostics: Attempted to register more than " // & "MAX_FIELDS_ diagnostic time derivatives via register_time_deriv.") @@ -1586,8 +1579,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 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(diagnostics_CS), pointer :: CS !< Pointer set to point to control structure - !! for this module. + type(diagnostics_CS), intent(inout) :: CS !< Diagnostic control struct type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -1612,13 +1604,6 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "MOM_diagnostics_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%diag => diag use_temperature = associated(tv%T) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & @@ -1737,11 +1722,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & 'Interface Height Relative to Mean Sea Level', 'm', conversion=US%Z_to_m) - if (CS%id_e>0) call safe_alloc_ptr(CS%e,isd,ied,jsd,jed,nz+1) + if (CS%id_e > 0) allocate(CS%e(isd:ied,jsd:jed,nz+1), source=0.) CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & 'Interface Height above the Seafloor', 'm', conversion=US%Z_to_m) - if (CS%id_e_D>0) call safe_alloc_ptr(CS%e_D,isd,ied,jsd,jed,nz+1) + if (CS%id_e_D > 0) allocate(CS%e_D(isd:ied,jsd:jed,nz+1), source=0.) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & 'Mixed Layer Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) @@ -1762,22 +1747,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if ((CS%id_du_dt>0) .and. .not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if ((CS%id_dv_dt>0) .and. .not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) - if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then - call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) + if ((CS%id_dh_dt>0) .and. .not. allocated(CS%dh_dt)) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif @@ -1786,8 +1771,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag ! v_extensive=.true.) !if (CS%id_hf_du_dt > 0) then ! call safe_alloc_ptr(CS%hf_du_dt,IsdB,IedB,jsd,jed,nz) - ! if (.not.associated(CS%du_dt)) then - ! call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + ! if (.not. allocated(CS%du_dt)) then + ! allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) ! call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) ! endif ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) @@ -1798,8 +1783,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag ! v_extensive=.true.) !if (CS%id_hf_dv_dt > 0) then ! call safe_alloc_ptr(CS%hf_dv_dt,isd,ied,JsdB,JedB,nz) - ! if (.not.associated(CS%dv_dt)) then - ! call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + ! if (.not. allocated(CS%dv_dt)) then + ! allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) ! call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) ! endif ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) @@ -1808,8 +1793,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_hf_du_dt_2d = register_diag_field('ocean_model', 'hf_dudt_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_du_dt_2d > 0) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if (.not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) @@ -1818,8 +1803,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_hf_dv_dt_2d = register_diag_field('ocean_model', 'hf_dvdt_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_dv_dt_2d > 0) then - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if (.not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) @@ -1828,8 +1813,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_h_du_dt = register_diag_field('ocean_model', 'h_du_dt', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt > 0) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if (.not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) @@ -1838,8 +1823,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_h_dv_dt = register_diag_field('ocean_model', 'h_dv_dt', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt > 0) then - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if (.not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) @@ -1850,27 +1835,27 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_h_Rlay = register_diag_field('ocean_model', 'h_rho', diag%axesTL, Time, & 'Layer thicknesses in pure potential density coordinates', & thickness_units, conversion=convert_H) - if (CS%id_h_Rlay>0) call safe_alloc_ptr(CS%h_Rlay,isd,ied,jsd,jed,nz) + if (CS%id_h_Rlay > 0) allocate(CS%h_Rlay(isd:ied,jsd:jed,nz), source=0.) CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uh_Rlay>0) call safe_alloc_ptr(CS%uh_Rlay,IsdB,IedB,jsd,jed,nz) + if (CS%id_uh_Rlay > 0) allocate(CS%uh_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vh_Rlay>0) call safe_alloc_ptr(CS%vh_Rlay,isd,ied,JsdB,JedB,nz) + if (CS%id_vh_Rlay > 0) allocate(CS%vh_Rlay(isd:ied,JsdB:JedB,nz), source=0.) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & 'Zonal volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uhGM_Rlay>0) call safe_alloc_ptr(CS%uhGM_Rlay,IsdB,IedB,jsd,jed,nz) + if (CS%id_uhGM_Rlay>0) allocate(CS%uhGM_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & 'Meridional volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vhGM_Rlay>0) call safe_alloc_ptr(CS%vhGM_Rlay,isd,ied,JsdB,JedB,nz) + if (CS%id_vhGM_Rlay>0) allocate(CS%vhGM_Rlay(isd:ied,JsdB:JedB,nz), source=0.) !endif @@ -1878,55 +1863,55 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE = register_diag_field('ocean_model', 'KE', diag%axesTL, Time, & 'Layer kinetic energy per unit mass', & 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (CS%id_KE>0) call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) + if (CS%id_KE > 0) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) CS%id_dKEdt = register_diag_field('ocean_model', 'dKE_dt', diag%axesTL, Time, & 'Kinetic Energy Tendency of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_dKEdt>0) call safe_alloc_ptr(CS%dKE_dt,isd,ied,jsd,jed,nz) + if (CS%id_dKEdt > 0) allocate(CS%dKE_dt(isd:ied,jsd:jed,nz), source=0.) CS%id_PE_to_KE = register_diag_field('ocean_model', 'PE_to_KE', diag%axesTL, Time, & 'Potential to Kinetic Energy Conversion of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_PE_to_KE>0) call safe_alloc_ptr(CS%PE_to_KE,isd,ied,jsd,jed,nz) + if (CS%id_PE_to_KE > 0) allocate(CS%PE_to_KE(isd:ied,jsd:jed,nz), source=0.) if (split) then CS%id_KE_BT = register_diag_field('ocean_model', 'KE_BT', diag%axesTL, Time, & 'Barotropic contribution to Kinetic Energy', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_BT>0) call safe_alloc_ptr(CS%KE_BT,isd,ied,jsd,jed,nz) + if (CS%id_KE_BT > 0) allocate(CS%KE_BT(isd:ied,jsd:jed,nz), source=0.) endif CS%id_KE_Coradv = register_diag_field('ocean_model', 'KE_Coradv', diag%axesTL, Time, & 'Kinetic Energy Source from Coriolis and Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_Coradv>0) call safe_alloc_ptr(CS%KE_Coradv,isd,ied,jsd,jed,nz) + if (CS%id_KE_Coradv > 0) allocate(CS%KE_Coradv(isd:ied,jsd:jed,nz), source=0.) CS%id_KE_adv = register_diag_field('ocean_model', 'KE_adv', diag%axesTL, Time, & 'Kinetic Energy Source from Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_adv>0) call safe_alloc_ptr(CS%KE_adv,isd,ied,jsd,jed,nz) + if (CS%id_KE_adv > 0) allocate(CS%KE_adv(isd:ied,jsd:jed,nz), source=0.) 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) - if (CS%id_KE_visc>0) call safe_alloc_ptr(CS%KE_visc,isd,ied,jsd,jed,nz) + if (CS%id_KE_visc > 0) allocate(CS%KE_visc(isd:ied,jsd:jed,nz), source=0.) 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) - if (CS%id_KE_stress>0) call safe_alloc_ptr(CS%KE_stress,isd,ied,jsd,jed,nz) + if (CS%id_KE_stress > 0) allocate(CS%KE_stress(isd:ied,jsd:jed,nz), source=0.) CS%id_KE_horvisc = register_diag_field('ocean_model', 'KE_horvisc', 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) - if (CS%id_KE_horvisc>0) call safe_alloc_ptr(CS%KE_horvisc,isd,ied,jsd,jed,nz) + if (CS%id_KE_horvisc > 0) allocate(CS%KE_horvisc(isd:ied,jsd:jed,nz), source=0.) if (.not. adiabatic) then CS%id_KE_dia = register_diag_field('ocean_model', 'KE_dia', diag%axesTL, Time, & 'Kinetic Energy Source from Diapycnal Diffusion', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_dia>0) call safe_alloc_ptr(CS%KE_dia,isd,ied,jsd,jed,nz) + if (CS%id_KE_dia > 0) allocate(CS%KE_dia(isd:ied,jsd:jed,nz), source=0.) endif ! gravity wave CFLs @@ -1954,13 +1939,12 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) !### call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018) - call safe_alloc_ptr(CS%cg1,isd,ied,jsd,jed) - if (CS%id_Rd1>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) - if (CS%id_Rd_ebt>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) - if (CS%id_cfl_cg1>0) call safe_alloc_ptr(CS%cfl_cg1,isd,ied,jsd,jed) - if (CS%id_cfl_cg1_x>0) call safe_alloc_ptr(CS%cfl_cg1_x,isd,ied,jsd,jed) - if (CS%id_cfl_cg1_y>0) call safe_alloc_ptr(CS%cfl_cg1_y,isd,ied,jsd,jed) - if (CS%id_p_ebt>0) call safe_alloc_ptr(CS%p_ebt,isd,ied,jsd,jed,nz) + allocate(CS%cg1(isd:ied,jsd:jed), source=0.) + if (CS%id_Rd1 > 0 .or. CS%id_Rd_ebt > 0) allocate(CS%Rd1(isd:ied,jsd:jed), source=0.) + if (CS%id_cfl_cg1 > 0) allocate(CS%cfl_cg1(isd:ied,jsd:jed), source=0.) + if (CS%id_cfl_cg1_x > 0) allocate(CS%cfl_cg1_x(isd:ied,jsd:jed), source=0.) + if (CS%id_cfl_cg1_y > 0) allocate(CS%cfl_cg1_y(isd:ied,jsd:jed), source=0.) + if (CS%id_p_ebt > 0) allocate(CS%p_ebt(isd:ied,jsd:jed,nz), source=0.) endif CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & @@ -2311,7 +2295,7 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) !! equation. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(diagnostics_CS), pointer :: CS !< Pointer to the control structure for this + type(diagnostics_CS), intent(inout) :: CS !< Pointer to the control structure for this !! module. ! This subroutine sets up diagnostics upon which other diagnostics depend. @@ -2319,49 +2303,50 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS%dKE_dt) .or. associated(CS%PE_to_KE) .or. & - associated(CS%KE_BT) .or. associated(CS%KE_CorAdv) .or. & - associated(CS%KE_adv) .or. associated(CS%KE_visc) .or. associated(CS%KE_stress) .or. & - associated(CS%KE_horvisc) .or. associated(CS%KE_dia)) & - call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) + if (allocated(CS%dKE_dt) .or. allocated(CS%PE_to_KE) .or. & + allocated(CS%KE_BT) .or. allocated(CS%KE_CorAdv) .or. & + allocated(CS%KE_adv) .or. allocated(CS%KE_visc) .or. allocated(CS%KE_stress) .or. & + allocated(CS%KE_horvisc) .or. allocated(CS%KE_dia)) then + if (.not. allocated(CS%KE)) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) + endif - if (associated(CS%dKE_dt)) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if (allocated(CS%dKE_dt)) then + if (.not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if (.not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif - if (.not.associated(CS%dh_dt)) then - call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) + if (.not. allocated(CS%dh_dt)) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif endif - if (associated(CS%KE_adv)) then + if (allocated(CS%KE_adv)) then call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_visc)) then + if (allocated(CS%KE_visc)) then 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 (associated(CS%KE_stress)) then + if (allocated(CS%KE_stress)) 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) endif - if (associated(CS%KE_dia)) then + if (allocated(CS%KE_dia)) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) endif - if (associated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) - if (associated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) + if (allocated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) + if (allocated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) end subroutine set_dependent_diagnostics @@ -2375,26 +2360,26 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) !! equation. integer :: m - if (associated(CS%e)) deallocate(CS%e) - if (associated(CS%e_D)) deallocate(CS%e_D) - if (associated(CS%KE)) deallocate(CS%KE) - if (associated(CS%dKE_dt)) deallocate(CS%dKE_dt) - if (associated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) - if (associated(CS%KE_BT)) deallocate(CS%KE_BT) - if (associated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) - if (associated(CS%KE_adv)) deallocate(CS%KE_adv) - if (associated(CS%KE_visc)) deallocate(CS%KE_visc) - if (associated(CS%KE_stress)) deallocate(CS%KE_stress) - if (associated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) - if (associated(CS%KE_dia)) deallocate(CS%KE_dia) - if (associated(CS%dv_dt)) deallocate(CS%dv_dt) - if (associated(CS%dh_dt)) deallocate(CS%dh_dt) - if (associated(CS%du_dt)) deallocate(CS%du_dt) - if (associated(CS%h_Rlay)) deallocate(CS%h_Rlay) - if (associated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) - if (associated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) - if (associated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) - if (associated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) + if (allocated(CS%e)) deallocate(CS%e) + if (allocated(CS%e_D)) deallocate(CS%e_D) + if (allocated(CS%KE)) deallocate(CS%KE) + if (allocated(CS%dKE_dt)) deallocate(CS%dKE_dt) + if (allocated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) + if (allocated(CS%KE_BT)) deallocate(CS%KE_BT) + if (allocated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) + if (allocated(CS%KE_adv)) deallocate(CS%KE_adv) + if (allocated(CS%KE_visc)) deallocate(CS%KE_visc) + if (allocated(CS%KE_stress)) deallocate(CS%KE_stress) + if (allocated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) + if (allocated(CS%KE_dia)) deallocate(CS%KE_dia) + if (allocated(CS%dh_dt)) deallocate(CS%dh_dt) + if (allocated(CS%dv_dt)) deallocate(CS%dv_dt) + if (allocated(CS%du_dt)) deallocate(CS%du_dt) + if (allocated(CS%h_Rlay)) deallocate(CS%h_Rlay) + if (allocated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) + if (allocated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) + if (allocated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) + if (allocated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) From c4fd89de58c4837e6a415e607923138cbb9b852a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 10 Nov 2021 10:18:27 -0500 Subject: [PATCH 23/29] set_visc_CS pointer removal Convert `set_visc_CS` pointer instances to locals --- src/core/MOM.F90 | 8 ++----- src/core/MOM_dynamics_split_RK2.F90 | 8 +++---- src/core/MOM_dynamics_unsplit.F90 | 9 +++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +++------ .../vertical/MOM_set_viscosity.F90 | 22 ++++--------------- 5 files changed, 15 insertions(+), 42 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 027127189d..72acebf88c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -351,7 +351,7 @@ module MOM !! This is also common referred to as Gent-McWilliams diffusion type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp !< Pointer to the control structure used for the mixed layer restratification - type(set_visc_CS), pointer :: set_visc_CSp => NULL() + type(set_visc_CS) :: set_visc_CSp !< Pointer to the control structure used to set viscosities type(diabatic_CS), pointer :: diabatic_CSp => NULL() !< Pointer to the control structure for the diabatic driver @@ -3609,12 +3609,8 @@ subroutine MOM_end(CS) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - call VarMix_end(CS%VarMix) - - if (associated(CS%set_visc_CSp)) & - call set_visc_end(CS%visc, CS%set_visc_CSp) - + call set_visc_end(CS%visc, CS%set_visc_CSp) call MEKE_end(CS%MEKE) if (associated(CS%tv%internal_heat)) deallocate(CS%tv%internal_heat) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 1a8e68bc8d..416333853b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1230,7 +1230,7 @@ end subroutine register_restarts_dyn_split_RK2 subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, thickness_diffuse_CSp, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, calc_dtbt, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1264,7 +1264,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control structure type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related type(directories), intent(in) :: dirs !< contains directory paths integer, target, intent(inout) :: ntrunc !< A target for the variable that records @@ -1395,9 +1395,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & activate=is_new_run(restart_CS) ) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6e2dfaad31..c0137fcd82 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -546,7 +546,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & Accel_diag, Cont_diag, MIS, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -581,8 +581,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE control !! structure. - type(set_visc_CS), pointer :: setVisc_CSp !< This points to the set_visc - !! control structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control struct type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities, bottom drag !! viscosities, and related fields. @@ -651,9 +650,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_unsplit called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) CS%OBC => OBC diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 4cbedafd6f..9d2a3cf3a2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -494,7 +494,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & Accel_diag, Cont_diag, MIS, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -526,9 +526,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! to the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE !! control structure. - type(set_visc_CS), pointer :: setVisc_CSp !< This points to the - !! set_visc control - !! structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set visc control struct type(vertvisc_type), intent(inout) :: visc !< A structure containing !! vertical viscosities, bottom drag !! viscosities, and related fields. @@ -613,9 +611,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_unsplit_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) CS%OBC => OBC diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 902c22240b..75fcb04831 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -130,7 +130,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) !! have NULL ptrs.. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. ! Local variables @@ -284,8 +284,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& - "Module must be initialized before it is used.") if (.not.CS%bottomdraglaw) return if (CS%debug) then @@ -1144,7 +1142,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. real, intent(in) :: dt !< Time increment [T ~> s]. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. ! Local variables @@ -1247,8 +1245,6 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& - "Module must be initialized before it is used.") if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. & associated(forces%frac_shelf_v)) ) return @@ -1896,8 +1892,7 @@ 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), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control struct type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure @@ -1932,13 +1927,6 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS # include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "set_visc_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%OBC => OBC is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2242,7 +2230,7 @@ end subroutine set_visc_init subroutine set_visc_end(visc, CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. Elements are deallocated here. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. if (CS%bottomdraglaw) then deallocate(visc%bbl_thick_u) ; deallocate(visc%bbl_thick_v) @@ -2269,8 +2257,6 @@ subroutine set_visc_end(visc, CS) if (associated(visc%tbl_thick_shelf_v)) deallocate(visc%tbl_thick_shelf_v) if (associated(visc%kv_tbl_shelf_u)) deallocate(visc%kv_tbl_shelf_u) if (associated(visc%kv_tbl_shelf_v)) deallocate(visc%kv_tbl_shelf_v) - - deallocate(CS) end subroutine set_visc_end !> \namespace mom_set_visc From 62edfdbf2431006717c6030cd82f4cc5c7c38ac1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 11 Nov 2021 11:51:59 -0500 Subject: [PATCH 24/29] tidal_bay_obc_cs pointer removal --- src/core/MOM_boundary_update.F90 | 9 ++++----- src/user/tidal_bay_initialization.F90 | 22 +++------------------- 2 files changed, 7 insertions(+), 24 deletions(-) diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index dc89f3f92c..286cec20d4 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -19,7 +19,7 @@ module MOM_boundary_update use MOM_verticalGrid, only : verticalGrid_type use DOME_initialization, only : register_DOME_OBC use tidal_bay_initialization, only : tidal_bay_set_OBC_data, register_tidal_bay_OBC -use tidal_bay_initialization, only : tidal_bay_OBC_end, tidal_bay_OBC_CS +use tidal_bay_initialization, only : tidal_bay_OBC_CS use Kelvin_initialization, only : Kelvin_set_OBC_data, register_Kelvin_OBC use Kelvin_initialization, only : Kelvin_OBC_end, Kelvin_OBC_CS use shelfwave_initialization, only : shelfwave_set_OBC_data, register_shelfwave_OBC @@ -44,7 +44,7 @@ module MOM_boundary_update !>@{ Pointers to the control structures for named OBC specifications type(file_OBC_CS), pointer :: file_OBC_CSp => NULL() type(Kelvin_OBC_CS), pointer :: Kelvin_OBC_CSp => NULL() - type(tidal_bay_OBC_CS), pointer :: tidal_bay_OBC_CSp => NULL() + type(tidal_bay_OBC_CS) :: tidal_bay_OBC type(shelfwave_OBC_CS), pointer :: shelfwave_OBC_CSp => NULL() type(dyed_channel_OBC_CS), pointer :: dyed_channel_OBC_CSp => NULL() !>@} @@ -118,7 +118,7 @@ subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) endif if (CS%use_tidal_bay) CS%use_tidal_bay = & - register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC_CSp, US, & + register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC, US, & OBC%OBC_Reg) if (CS%use_Kelvin) CS%use_Kelvin = & register_Kelvin_OBC(param_file, CS%Kelvin_OBC_CSp, US, & @@ -147,7 +147,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) ! if (CS%use_files) & ! call update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (CS%use_tidal_bay) & - call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, G, GV, h, Time) + call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, h, Time) if (CS%use_Kelvin) & call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, US, h, Time) if (CS%use_shelfwave) & @@ -164,7 +164,6 @@ subroutine OBC_register_end(CS) type(update_OBC_CS), pointer :: CS !< Control structure for OBCs if (CS%use_files) call file_OBC_end(CS%file_OBC_CSp) - if (CS%use_tidal_bay) call tidal_bay_OBC_end(CS%tidal_bay_OBC_CSp) if (CS%use_Kelvin) call Kelvin_OBC_end(CS%Kelvin_OBC_CSp) if (associated(CS)) deallocate(CS) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 136e5f9eee..51772e2f9f 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -20,7 +20,7 @@ module tidal_bay_initialization #include -public tidal_bay_set_OBC_data, tidal_bay_OBC_end +public tidal_bay_set_OBC_data public register_tidal_bay_OBC !> Control structure for tidal bay open boundaries. @@ -33,20 +33,13 @@ module tidal_bay_initialization !> Add tidal bay to OBC registry. function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. + type(tidal_bay_OBC_CS), intent(inout) :: CS !< tidal bay control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. logical :: register_tidal_bay_OBC character(len=32) :: casename = "tidal bay" !< This case's name. character(len=40) :: mdl = "tidal_bay_initialization" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "register_tidal_bay_OBC called with an "// & - "associated control structure.") - return - endif - allocate(CS) - 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) @@ -57,21 +50,12 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) end function register_tidal_bay_OBC -!> Clean up the tidal bay OBC from registry. -subroutine tidal_bay_OBC_end(CS) - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. - - if (associated(CS)) then - deallocate(CS) - endif -end subroutine tidal_bay_OBC_end - !> This subroutine sets the properties of flow at open boundary conditions. subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. + type(tidal_bay_OBC_CS), intent(in) :: CS !< tidal bay control 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 !< layer thickness [H ~> m or kg m-2] From c4df74852b9d7a76fddf188a7ced4b69da33b115 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 11 Nov 2021 13:47:20 -0500 Subject: [PATCH 25/29] Equation of state pointer removal * `EOS_type` pointers in MOM_EOS_mod moved to locals * Various `EOS_type` pointers changed to local * `eqn_of_state` removed from the following: - `adjustment_initialize_temperature_salinity` - `BFB_set_coord` - `dense_water_initialize_TS` - `DOME2d_initialize_temperature_salinity` - `dumbbell_initialize_temperature_salinity` - `Neverworld_initialize_thickness` - `Rossby_front_initialize_temperature_salinity` - `seamount_initialize_temperature_salinity` - `sloshing_initialize_temperature_salinity` - `USER_initialize_temperature_salinity` - `USER_set_coord` * `EOS` removed from neutral diffusion unit test NOTE: eqn_of_state in MOM_mod is retained, since there are many checks of pointer associated of `tv%eqn_of_state`. --- src/ALE/coord_hycom.F90 | 2 +- src/ALE/coord_rho.F90 | 4 +- src/ALE/coord_slight.F90 | 2 +- src/core/MOM.F90 | 5 +- src/core/MOM_density_integrals.F90 | 18 +-- src/equation_of_state/MOM_EOS.F90 | 150 ++++-------------- src/framework/MOM_diag_remap.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- .../MOM_coord_initialization.F90 | 19 +-- .../MOM_state_initialization.F90 | 22 +-- src/tracer/MOM_neutral_diffusion.F90 | 1 - src/tracer/MOM_tracer_Z_init.F90 | 12 +- src/user/BFB_initialization.F90 | 5 +- src/user/DOME2d_initialization.F90 | 5 +- src/user/ISOMIP_initialization.F90 | 2 +- src/user/Neverworld_initialization.F90 | 3 +- src/user/Rossby_front_2d_initialization.F90 | 3 +- src/user/adjustment_initialization.F90 | 4 +- src/user/benchmark_initialization.F90 | 4 +- src/user/dense_water_initialization.F90 | 3 +- src/user/dumbbell_initialization.F90 | 4 +- src/user/seamount_initialization.F90 | 4 +- src/user/sloshing_initialization.F90 | 4 +- src/user/user_initialization.F90 | 6 +- 24 files changed, 88 insertions(+), 198 deletions(-) diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 016e4016eb..4d70f925aa 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -98,7 +98,7 @@ end subroutine set_hycom_params subroutine build_hycom1_column(CS, 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure + 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 [degC] diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 6c9934ce38..4a9872d429 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -95,7 +95,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: T !< Temperature for source column [degC] real, dimension(nz), intent(in) :: S !< Salinity for source column [ppt] - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(CS%nk+1), & intent(inout) :: z_interface !< Absolute positions of interfaces real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (positive upward in the same @@ -208,7 +208,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ real, dimension(nz), intent(in) :: h !< Layer thicknesses in Z coordinates [Z ~> m] real, dimension(nz), intent(in) :: T !< T for column [degC] real, dimension(nz), intent(in) :: S !< S for column [ppt] - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 5cfa09213f..23a390456e 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -181,7 +181,7 @@ 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), pointer :: eqn_of_state !< Equation of state 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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 72acebf88c..3dc12c57e7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2330,7 +2330,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate ! initialization routine for tv. - if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state, US) + if (use_EOS) then + allocate(CS%tv%eqn_of_state) + call EOS_init(param_file, CS%tv%eqn_of_state, US) + endif if (use_temperature) then allocate(CS%tv%TempxPmE(isd:ied,jsd:jed), source=0.0) if (use_geothermal) then diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index c4791de53c..9fb4fdabcc 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -56,7 +56,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly @@ -113,7 +113,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly @@ -364,7 +364,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] @@ -806,7 +806,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] @@ -1137,7 +1137,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, & !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly across @@ -1196,7 +1196,7 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d !! The calculation is mathematically identical with different values of !! alpha_ref, but alpha_ref alters the effects of roundoff, and !! answers do change. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly @@ -1419,7 +1419,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly @@ -1657,7 +1657,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: rho_ref !< Reference density with which calculation !! 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), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure 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] @@ -1736,7 +1736,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real :: fract_dp_at_pos !< The change in pressure from the layer top to !! fractional position pos [R L2 T-2 ~> Pa] ! Local variables diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e1b7b200d2..39b626985a 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -37,9 +37,7 @@ module MOM_EOS #include -public EOS_allocate public EOS_domain -public EOS_end public EOS_init public EOS_manual_init public EOS_quadrature @@ -167,7 +165,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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 density in !! combination with scaling given by US [various] @@ -175,9 +173,6 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) 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] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_scalar called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -216,7 +211,7 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, intent(in) :: Svar !< Variance of salinity [ppt2] real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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 density !! from kg m-3 to the desired units [R m3 kg-1] @@ -225,9 +220,6 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r 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] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_stanley_density_scalar called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -266,15 +258,12 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute - type(EOS_type), pointer :: EOS !< Equation of state structure + 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 density !! in combination with scaling given by US [various] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pressure, rho, start, npts, & @@ -312,7 +301,7 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh 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), pointer :: EOS !< Equation of state structure + 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 density !! from kg m-3 to the desired units [R m3 kg-1] @@ -320,9 +309,6 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pressure, rho, start, npts, & @@ -361,7 +347,7 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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) :: rho_ref !< A reference density [kg m-3] @@ -375,9 +361,6 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -421,7 +404,7 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, 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) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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) :: rho_ref !< A reference density [kg m-3] @@ -434,9 +417,6 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -489,7 +469,7 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -497,9 +477,6 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, dimension(size(specvol)) :: rho ! Density [kg m-3] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & @@ -534,7 +511,7 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, intent(out) :: specvol !< In situ? specific volume [m3 kg-1] or [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] or [R-1 m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -543,9 +520,6 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real :: spv_reference ! spv_ref converted to [m3 kg-1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") - pres(1) = EOS%RL2_T2_to_Pa*pressure Ta(1) = T ; Sa(1) = S @@ -572,7 +546,7 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] @@ -587,9 +561,6 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real :: spv_reference ! spv_ref converted to [m3 kg-1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -626,15 +597,12 @@ subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: pressure !< Pressure [Pa] or [other] real, intent(out) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa ! Local variables real :: p_scale ! A factor to convert pressure to units of Pa. - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale select case (EOS%form_of_TFreeze) @@ -659,7 +627,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca !! to the surface [degC] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. ! Local variables @@ -667,9 +635,6 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca real :: p_scale ! A factor to convert pressure to units of Pa. integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale if (p_scale == 1.0) then @@ -712,16 +677,13 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & @@ -755,7 +717,7 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do !! temperature [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity !! [R ppt-1 ~> kg m-3 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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 density @@ -766,9 +728,6 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -804,7 +763,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] real, intent(out) :: drho_dS !< The partial derivative of density with salinity, !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -812,9 +771,6 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -856,7 +812,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -866,9 +822,6 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then @@ -938,7 +891,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! [kg m-3 ppt-1 Pa-1] or [R ppt-1 Pa-1 ~> kg m-3 ppt-1 Pa-1] real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -946,9 +899,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -994,7 +944,7 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start !! [m3 kg-1 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(size(T)) :: press ! Pressure converted to [Pa] @@ -1003,9 +953,6 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start real, dimension(size(T)) :: dRho_dS ! Derivative of density with salinity [kg m-3 ppt-1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & @@ -1044,7 +991,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity !! [R-1 ppt-1 ~> m3 kg-1 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + 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 specific @@ -1056,9 +1003,6 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -1095,15 +1039,12 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) !! [s2 m-2] or [T2 L-2] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] integer :: i, is, ie - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_compress called with an unassociated EOS_type EOS.") - is = start ; ie = is + npts - 1 do i=is,ie ; pressure(i) = EOS%RL2_T2_to_Pa * press(i) ; enddo @@ -1142,13 +1083,11 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(out) :: rho !< In situ density [kg m-3] or [R ~> kg m-3] real, intent(out) :: drho_dp !< The partial derivative of density with pressure (also the !! inverse of the square of sound speed) [s2 m-2] or [T2 L-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_compress called with an unassociated EOS_type EOS.") Ta(1) = T ; Sa(1) = S; pa(1) = pressure call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS) @@ -1198,7 +1137,7 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure 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] or [m2 s-2] @@ -1226,9 +1165,6 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real :: 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] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "int_specific_vol_dp called with an unassociated EOS_type EOS.") - ! 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!") @@ -1271,7 +1207,7 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure 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] or [Pa] @@ -1299,9 +1235,6 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, ! desired units [R m3 kg-1 ~> 1] real :: pres_scale ! A multiplicative factor to convert pressure into Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "int_density_dz called with an unassociated EOS_type EOS.") - ! 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!") @@ -1338,10 +1271,7 @@ end subroutine analytic_int_density_dz !> Returns true if the equation of state is compressible (i.e. has pressure dependence) logical function query_compressible(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "query_compressible called with an unassociated EOS_type EOS.") + type(EOS_type), intent(in) :: EOS !< Equation of state structure query_compressible = EOS%compressible end function query_compressible @@ -1349,7 +1279,7 @@ end function query_compressible !> Initializes EOS_type by allocating and reading parameters subroutine EOS_init(param_file, EOS, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(inout) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type optional :: US ! Local variables @@ -1357,8 +1287,6 @@ subroutine EOS_init(param_file, EOS, US) character(len=40) :: mdl = "MOM_EOS" ! This module's name. character(len=40) :: tmpstr - if (.not.associated(EOS)) call EOS_allocate(EOS) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1457,7 +1385,7 @@ end subroutine EOS_init !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS) subroutine EOS_manual_init(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), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(inout) :: EOS !< Equation of state structure integer, optional, intent(in) :: form_of_EOS !< A coded integer indicating the equation of state to use. integer, optional, intent(in) :: form_of_TFreeze !< A coded integer indicating the expression for !! the potential temperature of the freezing point. @@ -1488,20 +1416,6 @@ subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Co end subroutine EOS_manual_init -!> Allocates EOS_type -subroutine EOS_allocate(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) allocate(EOS) -end subroutine EOS_allocate - -!> Deallocates EOS_type -subroutine EOS_end(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (associated(EOS)) deallocate(EOS) -end subroutine EOS_end - !> Set equation of state structure (EOS) to linear with given coefficients !! !! \note This routine is primarily for testing and allows a local copy of the @@ -1513,10 +1427,7 @@ subroutine EOS_use_linear(Rho_T0_S0, dRho_dT, dRho_dS, EOS, use_quadrature) real, intent(in) :: dRho_dS !< Partial derivative of density with salinity [kg m-3 ppt-1] logical, optional, intent(in) :: use_quadrature !< If true, always use the generic (quadrature) !! code for the integrals of density. - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "MOM_EOS.F90: EOS_use_linear() called with an unassociated EOS_type EOS.") + type(EOS_type), intent(inout) :: EOS !< Equation of state structure EOS%form_of_EOS = EOS_LINEAR EOS%Compressible = .false. @@ -1539,15 +1450,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) intent(inout) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(in) :: mask_z !< 3d mask regulating which points to convert. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer :: i, j, k real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp real :: p - if (.not.associated(EOS)) call MOM_error(FATAL, & - "convert_temp_salt_to_TEOS10 called with an unassociated EOS_type EOS.") - if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec @@ -1564,7 +1472,7 @@ end subroutine convert_temp_salt_for_TEOS10 !> Return value of EOS_quadrature logical function EOS_quadrature(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure EOS_quadrature = EOS%EOS_quadrature @@ -1573,7 +1481,7 @@ 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), pointer :: 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. diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index bb11d92673..f9e5a35a09 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -280,7 +280,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe real, dimension(:,:,:), intent(in) :: h !< New thickness [H ~> m or kg m-2] real, dimension(:,:,:), intent(in) :: T !< New temperatures [degC] real, dimension(:,:,:), intent(in) :: S !< New salinities [ppt] - type(EOS_type), pointer :: eqn_of_state !< A pointer to the equation of state + type(EOS_type), intent(in) :: eqn_of_state !< A pointer to the equation of state real, dimension(:,:,:), intent(inout) :: h_target !< The new diagnostic thicknesses [H ~> m or kg m-2] ! Local variables diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index afcad4fb06..77166cece0 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -157,7 +157,7 @@ module MOM_ice_shelf real :: input_thickness !< Ice thickness at an upstream open boundary [m]. type(time_type) :: Time !< The component's time. - type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the + type(EOS_type) :: eqn_of_state !< Type that indicates the !! equation of state to use. logical :: active_shelf_dynamics !< True if the ice shelf mass changes as a result !! the dynamic ice-shelf model. diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 4f04fb285f..eb0db68726 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -48,9 +48,6 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept ! This include declares and sets the variable "version". #include "version_variable.h" integer :: nz - type(EOS_type), pointer :: eos => NULL() - - if (associated(tv%eqn_of_state)) eos => tv%eqn_of_state nz = GV%ke @@ -86,17 +83,17 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept case ("linear") call set_coord_linear(GV%Rlay, GV%g_prime, GV, US, PF) case ("ts_ref") - call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("ts_profile") - call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("ts_range") - call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("file") call set_coord_from_file(GV%Rlay, GV%g_prime, GV, US, PF) case ("USER") - call user_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) + call user_set_coord(GV%Rlay, GV%g_prime, GV, US, PF) case ("BFB") - call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) + call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF) case ("none", "ALE") call set_coord_to_none(GV%Rlay, GV%g_prime, GV, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize_coord: "// & @@ -208,7 +205,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state !! [L2 Z-1 T-2 ~> m s-2]. 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. @@ -258,7 +255,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s !! interface [L2 Z-1 T-2 ~> m s-2]. 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. @@ -305,7 +302,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta !! interface [L2 Z-1 T-2 ~> m s-2]. 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6a4d4195d5..37acb8ca42 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -309,8 +309,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & just_read=just_read) case ("benchmark"); call benchmark_initialize_thickness(h, 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, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref) + case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, 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, & just_read=just_read) @@ -375,26 +375,26 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, PF, & just_read=just_read) case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & tv%S, h, 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, PF, eos, just_read=just_read) + tv%S, h, depth_tot, G, GV, 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) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & G, GV, US, PF, just_read=just_read) - case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & + case ("dense"); call dense_water_initialize_TS(G, GV, PF, tv%T, tv%S, & h, just_read=just_read) - case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, eos, & + 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: "//& "Unrecognized Temp & salt configuration "//trim(config)) @@ -1584,7 +1584,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. logical, intent(in) :: just_read !< If true, this call will only read diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 05909cb8fc..a06af6cd57 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -2390,7 +2390,6 @@ logical function ndiff_unit_tests_discontinuous(verbose) real, dimension(ns) :: PoL, PoR real, dimension(ns-1) :: hEff, Flx type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure - type(EOS_type), pointer :: EOS !< Structure for linear equation of state type(remapping_CS), pointer :: remap_CS !< Remapping control structure (PLM) real, dimension(nk,2) :: ppoly_T_l, ppoly_T_r ! Linear reconstruction for T real, dimension(nk,2) :: ppoly_S_l, ppoly_S_r ! Linear reconstruction for S diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index cd6572cc9c..1be976d3f2 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -559,7 +559,7 @@ 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, land_fill, h, k_start, G, GV, US, & - eos, h_massless) + EOS, 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)), & @@ -575,7 +575,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, 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), pointer :: eos !< seawater equation of state control structure + type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure real, optional, intent(in) :: h_massless !< A threshold below which a layer is !! determined to be massless [H ~> m or kg m-2] @@ -627,9 +627,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, adjust_salt = .true. iter_loop: do itt = 1,niter do k=1,nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, EOSdom ) + 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), & - eos, EOSdom ) + 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 @@ -656,9 +656,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, if (adjust_salt .and. old_fit) then ; do itt = 1,niter do k=1,nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, EOSdom ) + 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), & - eos, EOSdom ) + 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 diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 49c0a03235..922ae60fc5 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -35,15 +35,14 @@ module BFB_initialization !! This case is set up in such a way that the temperature of the topmost layer is equal to the SST at the !! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers !! and linearly interpolated for the intermediate layers. -subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) +subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(GV%ke), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(GV%ke+1), intent(out) :: g_prime !< The reduced gravity at each !! interface [L2 Z-1 T-2 ~> m s-2]. 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure - ! Local variables + 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. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index bc689b112e..42279be8e3 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -220,19 +220,16 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration -subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) 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 [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure 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 real :: x integer :: index_bay_z diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 580fab1ac6..5fe228e278 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -258,7 +258,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U 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 - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 3f5b8c8ab2..5d992b572f 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -239,7 +239,7 @@ end function circ_ridge !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, P_ref) +subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, P_ref) 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 @@ -250,7 +250,6 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. ! Local variables diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index d7af8af0e4..c35386a2fe 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -107,14 +107,13 @@ end subroutine Rossby_front_initialize_thickness !> Initialization of temperature and salinity in the Rossby front test subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & - param_file, eqn_of_state, just_read) + param_file, just_read) type(ocean_grid_type), intent(in) :: G !< 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 [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index c39561513c..934536d1f8 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -190,8 +190,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, & - eqn_of_state, just_read) +subroutine adjustment_initialize_temperature_salinity(T, S, 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) :: T !< The temperature that is being initialized. @@ -201,7 +200,6 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, 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(EOS_type), pointer :: eqn_of_state !< Equation of state. logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T & S. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index e0dc87c96e..b955f75a32 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -93,7 +93,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e 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(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. logical, intent(in) :: just_read !< If true, this call will @@ -224,7 +224,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. logical, intent(in) :: just_read !< If true, this call will only read diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 9169b27a06..99836f5ad0 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -95,11 +95,10 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment -subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, just_read) +subroutine dense_water_initialize_TS(G, GV, param_file, T, S, h, just_read) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< EOS structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 6bc3dd67af..ac4181d570 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -206,15 +206,13 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, end subroutine dumbbell_initialize_thickness !> Initial values for temperature and salinity for the dumbbell test case -subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 20e42de41b..3dba7bfe59 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -189,15 +189,13 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j end subroutine seamount_initialize_thickness !> Initial values for temperature and salinity -subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 0c1cf59df8..3bafdb2d02 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -176,8 +176,7 @@ end subroutine sloshing_initialize_thickness !! reference surface layer salinity and temperature and a specified range. !! 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, param_file, & - eqn_of_state, just_read) +subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) 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 [degC]. @@ -186,7 +185,6 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure. logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 915be87e8a..d719e5867c 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -37,7 +37,7 @@ module user_initialization contains !> Set vertical coordinates. -subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) +subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(GV%ke), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(GV%ke+1), intent(out) :: g_prime !< The reduced gravity at each @@ -46,7 +46,6 @@ subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure call MOM_error(FATAL, & "USER_initialization.F90, USER_set_coord: " // & @@ -128,7 +127,7 @@ end subroutine USER_initialize_velocity !> This function puts the initial layer temperatures and salinities !! into T(:,:,:) and S(:,:,:). -subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, just_read) +subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, just_read) 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 [degC]. @@ -136,7 +135,6 @@ subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will only !! read parameters without changing T & S. From 4ee4dc595deb098cc6f455ebf30acdd52066cc86 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 12 Nov 2021 22:20:36 -0500 Subject: [PATCH 26/29] CoriolisAdv_CS pointer removal Redefine Coriolis advection pointers as locals --- src/core/MOM_CoriolisAdv.F90 | 14 +++----------- src/core/MOM_dynamics_split_RK2.F90 | 13 ++++++------- src/core/MOM_dynamics_unsplit.F90 | 10 +++++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +++++----- 4 files changed, 19 insertions(+), 28 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 3a3ba6920c..08deeb7d0e 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -134,7 +134,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -245,8 +245,6 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), ! uh(is-1,ie,js:je+1) and vh(is:ie+1,js-1:je). - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_CoriolisAdv: Module must be initialized before it is used.") 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 vol_neglect = GV%H_subroundoff * (1e-4 * US%m_to_L)**2 @@ -1034,7 +1032,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. @@ -1113,7 +1111,7 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics - type(CoriolisAdv_CS), pointer :: CS !< Control structure fro MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure fro MOM_CoriolisAdv ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1125,12 +1123,6 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "CoriolisAdv_init called with associated control structure.") - return - endif - allocate(CS) - CS%diag => diag ; CS%Time => Time ! Read all relevant parameters and write them to the model log. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 416333853b..74e0b8f33d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -202,8 +202,8 @@ module MOM_dynamics_split_RK2 type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + !> The CoriolisAdv control structure + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to a structure containing interface height diffusivities @@ -478,7 +478,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -731,7 +731,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1388,7 +1388,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -1698,8 +1698,7 @@ subroutine end_dyn_split_RK2(CS) call tidal_forcing_end(CS%tides_CSp) - call CoriolisAdv_end(CS%CoriolisAdv_Csp) - deallocate(CS%CoriolisAdv_CSp) + call CoriolisAdv_end(CS%CoriolisAdv) call continuity_end(CS%continuity_CSp) deallocate(CS%continuity_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index c0137fcd82..fb457b1652 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -145,7 +145,7 @@ module MOM_dynamics_unsplit !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to the vertvisc control structure @@ -297,7 +297,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -363,7 +363,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -441,7 +441,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -643,7 +643,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 9d2a3cf3a2..72614ab3e0 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -146,8 +146,8 @@ module MOM_dynamics_unsplit_RK2 type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + !> The CoriolisAdv control structure + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to the vertvisc control structure @@ -291,7 +291,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) (function of h[n-1/2]) @@ -361,7 +361,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) @@ -604,7 +604,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) From dc9adeb0237229c32d257ce2c145bf646b326a6a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sun, 14 Nov 2021 22:18:20 -0500 Subject: [PATCH 27/29] PressureForce CS pointer removal * The following control structures were moved to locals: * `PressureForce_CS` * `PressureForce_FV_CS` * `PressureForce_Mont_CS` * The `*_end()` functions no longer do anything and were removed --- src/core/MOM_PressureForce.F90 | 44 ++++++--------------- src/core/MOM_PressureForce_FV.F90 | 26 ++---------- src/core/MOM_PressureForce_Montgomery.F90 | 48 +++++++---------------- src/core/MOM_dynamics_split_RK2.F90 | 9 +---- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- 6 files changed, 35 insertions(+), 96 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 0ac1eb1ae1..844d9db4bc 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -8,10 +8,10 @@ module MOM_PressureForce use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_PressureForce_FV, only : PressureForce_FV_Bouss, PressureForce_FV_nonBouss -use MOM_PressureForce_FV, only : PressureForce_FV_init, PressureForce_FV_end +use MOM_PressureForce_FV, only : PressureForce_FV_init use MOM_PressureForce_FV, only : PressureForce_FV_CS use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss -use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end +use MOM_PressureForce_Mont, only : PressureForce_Mont_init use MOM_PressureForce_Mont, only : PressureForce_Mont_CS use MOM_tidal_forcing, only : tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type @@ -22,16 +22,16 @@ module MOM_PressureForce #include -public PressureForce, PressureForce_init, PressureForce_end +public PressureForce, PressureForce_init !> Pressure force control structure type, public :: PressureForce_CS ; private logical :: Analytic_FV_PGF !< If true, use the analytic finite volume form !! (Adcroft et al., Ocean Mod. 2008) of the PGF. !> Control structure for the analytically integrated finite volume pressure force - type(PressureForce_FV_CS), pointer :: PressureForce_FV_CSp => NULL() + type(PressureForce_FV_CS) :: PressureForce_FV !> Control structure for the Montgomery potential form of pressure force - type(PressureForce_Mont_CS), pointer :: PressureForce_Mont_CSp => NULL() + type(PressureForce_Mont_CS) :: PressureForce_Mont end type PressureForce_CS contains @@ -48,7 +48,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] - type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean interface [R L2 T-2 ~> Pa]. @@ -61,18 +61,18 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e if (CS%Analytic_FV_PGF) then if (GV%Boussinesq) then - call PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV_CSp, & + call PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV, & ALE_CSp, p_atm, pbce, eta) else - call PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV_CSp, & + call PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV, & ALE_CSp, p_atm, pbce, eta) endif else if (GV%Boussinesq) then - call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont, & p_atm, pbce, eta) else - call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont, & p_atm, pbce, eta) endif endif @@ -87,17 +87,11 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure type(tidal_forcing_CS), intent(inout), optional :: tides_CSp !< Tide control structure #include "version_variable.h" character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ANALYTIC_FV_PGF", CS%Analytic_FV_PGF, & @@ -109,25 +103,13 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) if (CS%Analytic_FV_PGF) then call PressureForce_FV_init(Time, G, GV, US, param_file, diag, & - CS%PressureForce_FV_CSp, tides_CSp) + CS%PressureForce_FV, tides_CSp) else call PressureForce_Mont_init(Time, G, GV, US, param_file, diag, & - CS%PressureForce_Mont_CSp, tides_CSp) + CS%PressureForce_Mont, tides_CSp) endif - end subroutine PressureForce_init -!> Deallocate the pressure force control structure -subroutine PressureForce_end(CS) - type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure - - if (CS%Analytic_FV_PGF) then - call PressureForce_FV_end(CS%PressureForce_FV_CSp) - else - call PressureForce_Mont_end(CS%PressureForce_Mont_CSp) - endif -end subroutine PressureForce_end - !> \namespace mom_pressureforce !! !! This thin module provides a branch to two forms of the horizontal accelerations diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index ef5a85697c..112730fb59 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -24,7 +24,7 @@ module MOM_PressureForce_FV #include -public PressureForce_FV_init, PressureForce_FV_end +public PressureForce_FV_init public PressureForce_FV_Bouss, PressureForce_FV_nonBouss ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional @@ -84,7 +84,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(in) :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. @@ -163,8 +163,6 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.") if (CS%Stanley_T2_det_coeff>=0.) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//& "implemented in non-Boussinesq mode.") @@ -424,7 +422,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(in) :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. @@ -499,9 +497,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_FV_Bouss: Module must be initialized before it is used.") - use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) do i=Isq,Ieq+1 ; p0(i) = 0.0 ; enddo @@ -807,19 +802,13 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF 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 ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ; CS%Time => Time if (present(tides_CSp)) & CS%tides_CSp => tides_CSp @@ -882,13 +871,6 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS end subroutine PressureForce_FV_init -!> Deallocates the finite volume pressure gradient control structure -subroutine PressureForce_FV_end(CS) - type(PressureForce_FV_CS), pointer :: CS !< Finite volume pressure control structure that - !! will be deallocated in this subroutine. - if (associated(CS)) deallocate(CS) -end subroutine PressureForce_FV_end - !> \namespace mom_pressureforce_fv !! !! Provides the Boussinesq and non-Boussinesq forms of horizontal accelerations diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4b98e0f73f..d77d31484a 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -21,7 +21,7 @@ module MOM_PressureForce_Mont #include public PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss, Set_pbce_Bouss -public Set_pbce_nonBouss, PressureForce_Mont_init, PressureForce_Mont_end +public Set_pbce_nonBouss, PressureForce_Mont_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 @@ -39,9 +39,9 @@ module MOM_PressureForce_Mont type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() !< Zonal accelerations due to pressure gradients + real, allocatable :: PFu_bc(:,:,:) !< Zonal accelerations due to pressure gradients !! deriving from density gradients within layers [L T-2 ~> m s-2]. - real, pointer :: PFv_bc(:,:,:) => NULL() !< Meridional accelerations due to pressure gradients + real, allocatable :: PFv_bc(:,:,:) !< Meridional accelerations due to pressure gradients !! deriving from density gradients within layers [L T-2 ~> m s-2]. !>@{ Diagnostic IDs integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 @@ -70,7 +70,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) [L T-2 ~> m s-2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF + type(PressureForce_Mont_CS), intent(inout) :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -137,8 +137,6 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_Mont: Module must be initialized before it is used.") if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_nonBouss: The Montgomery form of the pressure force "//& @@ -321,14 +319,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ((dp_star(i,j)*dp_star(i+1,j) + (p(i,j,K)*dp_star(i+1,j) + p(i+1,j,K)*dp_star(i,j))) / & (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc - if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc + if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((dp_star(i,j)*dp_star(i,j+1) + (p(i,j,K)*dp_star(i,j+1) + p(i,j+1,K)*dp_star(i,j))) / & (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -366,7 +364,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) [L T-2 ~> m s-2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF + type(PressureForce_Mont_CS), intent(inout) :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in @@ -424,8 +422,6 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_Mont: Module must be initialized before it is used.") if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_Bouss: The Montgomery form of the pressure force "//& @@ -555,14 +551,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + & e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc - if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc + if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + & e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -824,7 +820,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure + type(PressureForce_Mont_CS), intent(inout) :: CS !< Montgomery PGF control structure type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! Local variables @@ -833,12 +829,6 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ # include "version_variable.h" character(len=40) :: mdl ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ; CS%Time => Time if (present(tides_CSp)) & CS%tides_CSp => tides_CSp @@ -861,14 +851,10 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ 'Density Gradient Zonal Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) CS%id_PFv_bc = register_diag_field('ocean_model', 'PFv_bc', diag%axesCvL, Time, & 'Density Gradient Meridional Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) - if (CS%id_PFu_bc > 0) then - call safe_alloc_ptr(CS%PFu_bc,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) - CS%PFu_bc(:,:,:) = 0.0 - endif - if (CS%id_PFv_bc > 0) then - call safe_alloc_ptr(CS%PFv_bc,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) - CS%PFv_bc(:,:,:) = 0.0 - endif + if (CS%id_PFu_bc > 0) & + allocate(CS%PFu_bc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.) + if (CS%id_PFv_bc > 0) & + allocate(CS%PFv_bc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.) endif if (CS%tides) then @@ -883,12 +869,6 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ end subroutine PressureForce_Mont_init -!> Deallocates the Montgomery-potential form of PGF control structure -subroutine PressureForce_Mont_end(CS) - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - if (associated(CS)) deallocate(CS) -end subroutine PressureForce_Mont_end - !>\namespace mom_pressureforce_mont !! !! Provides the Boussunesq and non-Boussinesq forms of the horizontal diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 74e0b8f33d..e4da652181 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -55,7 +55,7 @@ module MOM_dynamics_split_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_open_boundary, only : open_boundary_test_extern_h, update_OBC_ramp use MOM_PressureForce, only : PressureForce, PressureForce_CS -use MOM_PressureForce, only : PressureForce_init, PressureForce_end +use MOM_PressureForce, only : PressureForce_init use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_CS @@ -205,7 +205,7 @@ module MOM_dynamics_split_RK2 !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to a structure containing interface height diffusivities type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure @@ -1692,12 +1692,7 @@ subroutine end_dyn_split_RK2(CS) deallocate(CS%vertvisc_CSp) call hor_visc_end(CS%hor_visc) - - call PressureForce_end(CS%PressureForce_CSp) - deallocate(CS%PressureForce_CSp) - call tidal_forcing_end(CS%tides_CSp) - call CoriolisAdv_end(CS%CoriolisAdv) call continuity_end(CS%continuity_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index fb457b1652..536d7dfc52 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -147,7 +147,7 @@ module MOM_dynamics_unsplit !> A pointer to the CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to the vertvisc control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 72614ab3e0..87e3d5e3bf 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -149,7 +149,7 @@ module MOM_dynamics_unsplit_RK2 !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to the vertvisc control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure From a250208448482f92dfc2b5dd171898039c4533fc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 15 Nov 2021 15:26:12 -0500 Subject: [PATCH 28/29] MOM continuity CS pointer removal These pointers were defined as locals * `MOM_continuity_CS` * `MOM_continuity_PPM_CS` --- src/core/MOM_continuity.F90 | 34 +++++++-------------------- src/core/MOM_continuity_PPM.F90 | 34 ++++++++------------------- src/core/MOM_dynamics_split_RK2.F90 | 8 ++----- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- 5 files changed, 23 insertions(+), 57 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 655055b03d..2c970e5af1 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -5,7 +5,7 @@ module MOM_continuity use MOM_continuity_PPM, only : continuity_PPM, continuity_PPM_init use MOM_continuity_PPM, only : continuity_PPM_stencil -use MOM_continuity_PPM, only : continuity_PPM_end, continuity_PPM_CS +use MOM_continuity_PPM, only : continuity_PPM_CS use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -20,7 +20,7 @@ module MOM_continuity #include -public continuity, continuity_init, continuity_end, continuity_stencil +public continuity, continuity_init, continuity_stencil !> Control structure for mom_continuity type, public :: continuity_CS ; private @@ -29,7 +29,7 @@ module MOM_continuity !! - PPM - A directionally split piecewise parabolic reconstruction solver. !! The default, PPM, seems most appropriate for use with our current !! time-splitting strategies. - type(continuity_PPM_CS), pointer :: PPM_CSp => NULL() !< Control structure for mom_continuity_ppm + type(continuity_PPM_CS) :: PPM !< Control structure for mom_continuity_ppm end type continuity_CS integer, parameter :: PPM_SCHEME = 1 !< Enumerated constant to select PPM @@ -59,7 +59,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, !! 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_CS), pointer :: CS !< Control structure for mom_continuity. + type(continuity_CS), intent(in) :: CS !< Control structure for mom_continuity. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume @@ -95,7 +95,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, OBC, uhbt, vhbt, & + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM, OBC, uhbt, vhbt, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") @@ -111,19 +111,13 @@ subroutine continuity_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 !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + type(continuity_CS), intent(inout) :: CS !< Control structure for mom_continuity. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_continuity" ! This module's name. character(len=20) :: tmpstr - if (associated(CS)) then - call MOM_error(WARNING, "continuity_init called with associated control structure.") - return - endif - allocate(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, "CONTINUITY_SCHEME", tmpstr, & @@ -145,7 +139,7 @@ subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM) endif end subroutine continuity_init @@ -153,24 +147,14 @@ end subroutine continuity_init !> continuity_stencil returns the continuity solver stencil size function continuity_stencil(CS) result(stencil) - type(continuity_CS), pointer :: CS !< Module's control structure. + type(continuity_CS), intent(in) :: CS !< Module's control structure. integer :: stencil !< The continuity solver stencil size with the current settings. stencil = 1 if (CS%continuity_scheme == PPM_SCHEME) then - stencil = continuity_PPM_stencil(CS%PPM_CSp) + stencil = continuity_PPM_stencil(CS%PPM) endif - end function continuity_stencil -!> Destructor for continuity_cs. -subroutine continuity_end(CS) - type(continuity_CS), intent(inout) :: CS !< Control structure for mom_continuity. - - if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_end(CS%PPM_CSp) - endif -end subroutine continuity_end - end module MOM_continuity diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a9cd01a6df..cc56654d30 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -18,7 +18,7 @@ module MOM_continuity_PPM #include -public continuity_PPM, continuity_PPM_init, continuity_PPM_end, continuity_PPM_stencil +public continuity_PPM, continuity_PPM_init, continuity_PPM_stencil !>@{ CPU time clock IDs integer :: id_clock_update, id_clock_correct @@ -91,7 +91,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh intent(out) :: vh !< Meridional volume flux, 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), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces @@ -134,8 +134,6 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh h_min = GV%Angstrom_H - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_continuity_PPM: Module must be initialized before it is used.") x_first = (MOD(G%first_direction,2) == 0) if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & @@ -220,7 +218,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & !! [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), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & @@ -736,7 +734,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! The barotropic velocity adjustment [L T-1 ~> m 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), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -878,7 +876,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! value of du [L T-1 ~> m 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), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer @@ -1029,7 +1027,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & !! faces = v*h*dx [H L2 s-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), pointer :: CS !< This module's control structure.G + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. @@ -1545,7 +1543,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m 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), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1688,7 +1686,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! of dv [L T-1 ~> m 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), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -2198,18 +2196,12 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to !! regulate diagnostic output. - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(inout) :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" real :: tol_eta_m ! An unscaled version of tol_eta [m]. character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "continuity_PPM_init called with associated control structure.") - return - endif - allocate(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, "MONOTONIC_CONTINUITY", CS%monotonic, & @@ -2286,19 +2278,13 @@ end subroutine continuity_PPM_init !> continuity_PPM_stencil returns the continuity solver stencil size function continuity_PPM_stencil(CS) result(stencil) - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. integer :: stencil !< The continuity solver stencil size with the current settings. stencil = 3 ; if (CS%simple_2nd) stencil = 2 ; if (CS%upwind_1st) stencil = 1 end function continuity_PPM_stencil -!> Destructor for continuity_ppm_cs -subroutine continuity_PPM_end(CS) - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. - deallocate(CS) -end subroutine continuity_PPM_end - !> \namespace mom_continuity_ppm !! !! This module contains the subroutines that advect layer diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e4da652181..0459b8123c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -39,8 +39,7 @@ module MOM_dynamics_split_RK2 use MOM_barotropic, only : barotropic_end use MOM_boundary_update, only : update_OBC_data, update_OBC_CS use MOM_continuity, only : continuity, continuity_CS -use MOM_continuity, only : continuity_init, continuity_end -use MOM_continuity, only : continuity_stencil +use MOM_continuity, only : continuity_init, continuity_stencil use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_CS use MOM_CoriolisAdv, only : CoriolisAdv_init, CoriolisAdv_end use MOM_debugging, only : check_redundant @@ -201,7 +200,7 @@ module MOM_dynamics_split_RK2 !> A pointer to the horizontal viscosity control structure type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure @@ -1695,9 +1694,6 @@ subroutine end_dyn_split_RK2(CS) call tidal_forcing_end(CS%tides_CSp) call CoriolisAdv_end(CS%CoriolisAdv) - call continuity_end(CS%continuity_CSp) - deallocate(CS%continuity_CSp) - DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 536d7dfc52..d1a5de002b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -143,7 +143,7 @@ module MOM_dynamics_unsplit !> A pointer to the horizontal viscosity control structure type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> A pointer to the CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 87e3d5e3bf..a609ac8683 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -145,7 +145,7 @@ module MOM_dynamics_unsplit_RK2 !> A pointer to the horizontal viscosity control structure type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure From d00c90b60eb7ef8d572ea3361730f2cbdff3e0dc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 16 Nov 2021 09:50:10 -0500 Subject: [PATCH 29/29] MOM_open_boundary pointer removal This patch replaces many pointers in the OBC with local or allocatable variables. Notes: * `OBC` redeclared as `target` in some places for `segment` pointers * `field_names` removed from `OBC_segment_type` * `Tr_Reg` removed from `set_tracer_data` * `OBC` removed from `deallocate_OBC_segment_data` --- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_open_boundary.F90 | 358 ++++++++---------- .../MOM_state_initialization.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 12 +- src/user/DOME_initialization.F90 | 2 +- src/user/Kelvin_initialization.F90 | 4 +- 6 files changed, 179 insertions(+), 201 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index f49ce0073b..32eb036a94 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3039,7 +3039,7 @@ end subroutine apply_velocity_OBCs !! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, & integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), intent(inout) :: OBC !< An associated pointer to an OBC type. + type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ed885b9574..581cd5e68e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -75,26 +75,26 @@ 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 - character(len=8) :: name !< a name identifier for the segment data - real, dimension(:,:,:), allocatable :: buffer_src !< buffer for segment data located at cell faces - !! and on the original vertical grid - integer :: nk_src !< Number of vertical levels in the source data - real, dimension(:,:,:), allocatable :: dz_src !< vertical grid cell spacing of the incoming segment - !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] - real, dimension(:,:,:), pointer :: buffer_dst=>NULL() !< buffer src data remapped to the target vertical grid + 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 + real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces + !! and on the original vertical grid + integer :: nk_src !< Number of vertical levels in the source data + real, allocatable :: dz_src(:,:,:) !< vertical grid cell spacing of the incoming segment + !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] + real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. type, public :: OBC_segment_tracer_type - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array - real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows - character(len=32) :: name !< tracer name used for error messages - type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer - real, dimension(:,:,:), pointer :: tres => NULL() !< tracer reservoir array - logical :: is_initialized !< reservoir values have been set when True + real, allocatable :: t(:,:,:) !< tracer concentration array + real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows + character(len=32) :: name !< tracer name used for error messages + type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer + real, allocatable :: tres(:,:,:) !< tracer reservoir array + logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type !> Registry type for tracers on segments @@ -145,9 +145,8 @@ module MOM_open_boundary logical :: is_N_or_S !< True if the OB is facing North or South and exists on this PE. logical :: is_E_or_W !< True if the OB is facing East or West and exists on this PE. logical :: is_E_or_W_2 !< True if the OB is facing East or West anywhere. - type(OBC_segment_data_type), pointer, dimension(:) :: field=>NULL() !< OBC data + type(OBC_segment_data_type), pointer :: field(:) => NULL() !< OBC data integer :: num_fields !< number of OBC data fields (e.g. u_normal,u_parallel and eta for Flather) - character(len=32), pointer, dimension(:) :: field_names=>NULL() !< field names for this segment integer :: Is_obc !< i-indices of boundary segment. integer :: Ie_obc !< i-indices of boundary segment. integer :: Js_obc !< j-indices of boundary segment. @@ -163,44 +162,44 @@ module MOM_open_boundary logical :: on_pe !< true if any portion of the segment is located in this PE's data domain logical :: temp_segment_data_exists !< true if temperature data arrays are present logical :: salt_segment_data_exists !< true if salinity data arrays are present - real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [L T-1 ~> m s-1] - !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [T-1 ~> s-1]. - real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [H L2 T-1 ~> m3 s-1]. - real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the - !! segment [H ~> m or kg m-2]. - real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along - !! the segment times the grid spacing [T-1 ~> s-1] - real, pointer, dimension(:,:,:) :: rx_norm_rad=>NULL() !< The previous normal phase speed use for EW radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: ry_norm_rad=>NULL() !< The previous normal phase speed use for NS radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: rx_norm_obl=>NULL() !< The previous normal radiation coefficient for EW - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: ry_norm_obl=>NULL() !< The previous normal radiation coefficient for NS - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation - !! for normal velocity [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [T-1 ~> s-1]. + real, allocatable :: Cg(:,:) !< The external gravity wave speed [L T-1 ~> m s-1] + !! at OBC-points. + real, allocatable :: Htot(:,:) !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: h(:,:,:) !< The cell thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: normal_vel(:,:,:) !< The layer velocity normal to the OB + !! segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_vel(:,:,:) !< The layer velocity tangential to the + !! OB segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_grad(:,:,:) !< The gradient of the velocity tangential + !! to the OB segment [T-1 ~> s-1]. + real, allocatable :: normal_trans(:,:,:) !< The layer transport normal to the OB + !! segment [H L2 T-1 ~> m3 s-1]. + real, allocatable :: normal_vel_bt(:,:) !< The barotropic velocity normal to + !! the OB segment [L T-1 ~> m s-1]. + real, allocatable :: eta(:,:) !< The sea-surface elevation along the + !! segment [H ~> m or kg m-2]. + real, allocatable :: grad_normal(:,:,:) !< The gradient of the normal flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_tan(:,:,:) !< The gradient of the tangential flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_gradient(:,:,:) !< The gradient of the gradient of tangential flow along + !! the segment times the grid spacing [T-1 ~> s-1] + real, allocatable :: rx_norm_rad(:,:,:) !< The previous normal phase speed use for EW radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: ry_norm_rad(:,:,:) !< The previous normal phase speed use for NS radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: rx_norm_obl(:,:,:) !< The previous normal radiation coefficient for EW + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_norm_obl(:,:,:) !< The previous normal radiation coefficient for NS + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< The denominator for oblique radiation + !! for normal velocity [L2 T-2 ~> m2 s-2] + real, allocatable :: nudged_normal_vel(:,:,:) !< The layer velocity normal to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_vel(:,:,:) !< The layer velocity tangential to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_grad(:,:,:) !< The layer dvdx or dudy towards which nudging + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale_out !< An effective inverse length scale for restoring @@ -256,11 +255,9 @@ module MOM_open_boundary logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. - logical, pointer, dimension(:) :: & - tracer_x_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_x_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with x reservoirs (needed for restarts). - logical, pointer, dimension(:) :: & - tracer_y_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_y_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with y reservoirs (needed for restarts). integer :: ntr = 0 !< number of tracers integer :: n_tide_constituents = 0 !< Number of tidal constituents to add to the boundary. @@ -278,12 +275,10 @@ module MOM_open_boundary type(time_type) :: time_ref !< Reference date (t = 0) for tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Lunar and solar longitudes used to calculate tidal forcing. ! Properties of the segments used. - type(OBC_segment_type), pointer, dimension(:) :: & - segment => NULL() !< List of segment objects. + type(OBC_segment_type), allocatable :: segment(:) !< List of segment objects. ! Which segment object describes the current point. - integer, pointer, dimension(:,:) :: & - segnum_u => NULL(), & !< Segment number of u-points. - segnum_v => NULL() !< Segment number of v-points. + integer, allocatable :: segnum_u(:,:) !< Segment number of u-points. + integer, allocatable :: segnum_v(:,:) !< Segment number of v-points. ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation @@ -295,17 +290,15 @@ module MOM_open_boundary logical :: OBC_pe !< Is there an open boundary on this tile? type(remapping_CS), pointer :: remap_CS=> NULL() !< ALE remapping control structure for segments only type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries - real, pointer, dimension(:,:,:) :: & - rx_normal => NULL(), & !< Array storage for normal phase speed for EW radiation OBCs in units of - !! grid points per timestep [nondim] - ry_normal => NULL(), & !< Array storage for normal phase speed for NS radiation OBCs in units of - !! grid points per timestep [nondim] - rx_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - ry_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - cff_normal => NULL() !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:,:) :: & - tres_x => NULL(), & !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] - tres_y => NULL() !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: rx_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] real :: silly_h !< A silly value of thickness outside of the domain that can be used to test !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test @@ -651,9 +644,9 @@ end subroutine open_boundary_config !> Allocate space for reading OBC data from files. It sets up the required vertical !! remapping. In the process, it does funky stuff with the MPI processes. subroutine initialize_segment_data(G, OBC, PF) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + 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 character(len=1024) :: segstr @@ -688,7 +681,6 @@ subroutine initialize_segment_data(G, OBC, PF) ! Try this here just for the documentation. It is repeated below. do n=1, OBC%number_of_segments - segment => OBC%segment(n) write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n call get_param(PF, mdl, segnam, segstr, 'OBC segment docs') enddo @@ -958,14 +950,14 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data subroutine initialize_obc_tides(OBC, param_file) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing (year, month, day). integer, dimension(3) :: nodal_ref_date !< Date to calculate nodal modulation for (year, month, day). character(len=50) :: tide_constituent_str !< List of tidal constituents to include on boundary. - type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing - type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. - integer :: c !< Index to tidal constituent. + type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing + type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. + integer :: c !< Index to tidal constituent. call get_param(param_file, mdl, "OBC_TIDE_CONSTITUENTS", tide_constituent_str, & "Names of tidal constituents being added to the open boundaries.", & @@ -1175,7 +1167,7 @@ end subroutine setup_segment_indices !> Parse an OBC_SEGMENT_%%% string starting with "I=" and configure placement and type of OBC accordingly subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" @@ -1315,7 +1307,7 @@ end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" @@ -1638,8 +1630,8 @@ end subroutine parse_segment_data_str !> Parse all the OBC_SEGMENT_%%%_DATA strings again !! to see which need tracer reservoirs (all pes need to know). subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables @@ -1809,16 +1801,16 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) To_All+Scalar_Pair) if (OBC%oblique_BCs_exist_globally) call pass_vector(OBC%rx_oblique, OBC%ry_oblique, G%Domain, & To_All+Scalar_Pair) - if (associated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) - if (associated(OBC%tres_x) .and. associated(OBC%tres_y)) then + if (allocated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) + if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_vector(OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%Domain, To_All+Scalar_Pair) enddo - elseif (associated(OBC%tres_x)) then + elseif (allocated(OBC%tres_x)) then do m=1,OBC%ntr call pass_var(OBC%tres_x(:,:,:,m), G%Domain, position=EAST_FACE) enddo - elseif (associated(OBC%tres_y)) then + elseif (allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_var(OBC%tres_y(:,:,:,m), G%Domain, position=NORTH_FACE) enddo @@ -1897,18 +1889,18 @@ subroutine open_boundary_dealloc(OBC) do n=1, OBC%number_of_segments segment => OBC%segment(n) - call deallocate_OBC_segment_data(OBC, segment) + call deallocate_OBC_segment_data(segment) enddo - if (associated(OBC%segment)) deallocate(OBC%segment) - if (associated(OBC%segnum_u)) deallocate(OBC%segnum_u) - if (associated(OBC%segnum_v)) deallocate(OBC%segnum_v) - if (associated(OBC%rx_normal)) deallocate(OBC%rx_normal) - if (associated(OBC%ry_normal)) deallocate(OBC%ry_normal) - if (associated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) - if (associated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) - if (associated(OBC%cff_normal)) deallocate(OBC%cff_normal) - if (associated(OBC%tres_x)) deallocate(OBC%tres_x) - if (associated(OBC%tres_y)) deallocate(OBC%tres_y) + if (allocated(OBC%segment)) deallocate(OBC%segment) + if (allocated(OBC%segnum_u)) deallocate(OBC%segnum_u) + if (allocated(OBC%segnum_v)) deallocate(OBC%segnum_v) + if (allocated(OBC%rx_normal)) deallocate(OBC%rx_normal) + if (allocated(OBC%ry_normal)) deallocate(OBC%ry_normal) + if (allocated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) + if (allocated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) + if (allocated(OBC%cff_normal)) deallocate(OBC%cff_normal) + if (allocated(OBC%tres_x)) deallocate(OBC%tres_x) + if (allocated(OBC%tres_y)) deallocate(OBC%tres_y) deallocate(OBC) end subroutine open_boundary_dealloc @@ -2077,8 +2069,8 @@ end subroutine open_boundary_impose_land_mask subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - ! Local variables + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, m, n @@ -2088,7 +2080,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%t(i,j,k) @@ -2099,7 +2091,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%t(i,J,k) @@ -2209,7 +2201,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed segment%tr_Reg%Tr(m)%tres(I,j,k) = OBC%tres_x(I,j,k,m) @@ -2220,7 +2212,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied segment%tr_Reg%Tr(m)%tres(i,J,k) = OBC%tres_y(i,J,k,m) @@ -3298,7 +3290,7 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, GV, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(OBC_segment_type), pointer :: segment !< OBC segment structure + type(OBC_segment_type), intent(inout) :: segment !< OBC segment structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k @@ -3420,15 +3412,14 @@ end subroutine gradient_at_q_points !> Sets the initial values of the tracer open boundary conditions. !! Redoing this elsewhere. -subroutine set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure +subroutine set_tracer_data(OBC, tv, h, G, GV, PF) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness - type(param_file_type), intent(in) :: PF !< Parameter file handle - type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry - ! Local variables + type(ocean_OBC_type), target, intent(in) :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness + type(param_file_type), intent(in) :: PF !< Parameter file handle + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n integer :: isd_off, jsd_off integer :: IsdB, IedB, JsdB, JedB @@ -3484,7 +3475,7 @@ end subroutine set_tracer_data !> Needs documentation function lookup_seg_field(OBC_seg,field) - type(OBC_segment_type), pointer :: OBC_seg !< OBC segment + type(OBC_segment_type), intent(in) :: OBC_seg !< OBC segment character(len=32), intent(in) :: field !< The field name integer :: lookup_seg_field ! Local variables @@ -3503,7 +3494,7 @@ end function lookup_seg_field !> Allocate segment data fields subroutine allocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(in) :: OBC !< Open boundary structure type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables integer :: isd, ied, jsd, jed @@ -3593,35 +3584,35 @@ subroutine allocate_OBC_segment_data(OBC, segment) end subroutine allocate_OBC_segment_data !> Deallocate segment data fields -subroutine deallocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure +subroutine deallocate_OBC_segment_data(segment) type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables character(len=40) :: mdl = "deallocate_OBC_segment_data" ! This subroutine's name. if (.not. segment%on_pe) return - if (associated (segment%Cg)) deallocate(segment%Cg) - if (associated (segment%Htot)) deallocate(segment%Htot) - if (associated (segment%h)) deallocate(segment%h) - if (associated (segment%eta)) deallocate(segment%eta) - if (associated (segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) - if (associated (segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) - if (associated (segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) - if (associated (segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) - if (associated (segment%cff_normal)) deallocate(segment%cff_normal) - if (associated (segment%grad_normal)) deallocate(segment%grad_normal) - if (associated (segment%grad_tan)) deallocate(segment%grad_tan) - if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) - if (associated (segment%normal_vel)) deallocate(segment%normal_vel) - if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) - if (associated (segment%normal_trans)) deallocate(segment%normal_trans) - if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) - if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) - if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) - if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) - if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) - if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) + if (allocated(segment%Cg)) deallocate(segment%Cg) + if (allocated(segment%Htot)) deallocate(segment%Htot) + if (allocated(segment%h)) deallocate(segment%h) + if (allocated(segment%eta)) deallocate(segment%eta) + if (allocated(segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) + if (allocated(segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) + if (allocated(segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) + if (allocated(segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) + if (allocated(segment%cff_normal)) deallocate(segment%cff_normal) + if (allocated(segment%grad_normal)) deallocate(segment%grad_normal) + if (allocated(segment%grad_tan)) deallocate(segment%grad_tan) + if (allocated(segment%grad_gradient)) deallocate(segment%grad_gradient) + if (allocated(segment%normal_vel)) deallocate(segment%normal_vel) + if (allocated(segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) + if (allocated(segment%normal_trans)) deallocate(segment%normal_trans) + if (allocated(segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) + if (allocated(segment%tangential_vel)) deallocate(segment%tangential_vel) + if (allocated(segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (allocated(segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) + if (allocated(segment%tangential_grad)) deallocate(segment%tangential_grad) + + if (associated(segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) end subroutine deallocate_OBC_segment_data @@ -3738,14 +3729,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) integer :: i2, j2 ! indices for referencing local domain array integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain integer :: ishift, jshift ! offsets for staggered locations - real, dimension(:,:), pointer :: seg_vel => NULL() ! pointer to segment velocity array - real, dimension(:,:), pointer :: seg_trans => NULL() ! pointer to segment transport array real, dimension(:,:,:), allocatable, target :: tmp_buffer real, dimension(:), allocatable :: h_stack integer :: is_obc2, js_obc2 real :: net_H_src, net_H_int, scl_fac real :: tidal_vel, tidal_elev - real, pointer, dimension(:,:) :: normal_trans_bt=>NULL() ! barotropic transport + real, allocatable :: normal_trans_bt(:,:) ! barotropic transport integer :: turns ! Number of index quarter turns real :: time_delta ! Time since tidal reference date @@ -3816,7 +3805,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) 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) - if (.not.associated(segment%field(m)%buffer_dst)) then + if (.not.allocated(segment%field(m)%buffer_dst)) then if (siz(3) /= segment%field(m)%nk_src) call MOM_error(FATAL,'nk_src inconsistency') if (segment%field(m)%nk_src > 1) then if (segment%is_E_or_W) then @@ -4113,7 +4102,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (turns /= 0) & deallocate(tmp_buffer_in) else ! fid <= 0 (Uniform value) - if (.not. associated(segment%field(m)%buffer_dst)) then + if (.not. allocated(segment%field(m)%buffer_dst)) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) @@ -4178,7 +4167,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) & / (max(segment%Htot(I,j), 1.e-12 * GV%m_to_H) * G%dyCu(I,j)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then J=js_obc @@ -4200,10 +4189,10 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) & / (max(segment%Htot(i,J), 1.e-12 * GV%m_to_H) * G%dxCv(i,J)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then I=is_obc do J=js_obc,je_obc tidal_vel = 0.0 @@ -4217,11 +4206,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then J=js_obc do I=is_obc,ie_obc tidal_vel = 0.0 @@ -4235,27 +4224,27 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo endif elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then I=is_obc do J=js_obc,je_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then J=js_obc do I=is_obc,ie_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo @@ -4314,7 +4303,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif if (trim(segment%field(m)%name) == 'TEMP') then - if (associated(segment%field(m)%buffer_dst)) then + 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(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4329,7 +4318,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%tr_Reg%Tr(1)%OBC_inflow_conc = segment%field(m)%value endif elseif (trim(segment%field(m)%name) == 'SALT') then - if (associated(segment%field(m)%buffer_dst)) then + 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(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4358,7 +4347,7 @@ end subroutine update_OBC_segment_data !! value of Time as the beginning of the ramp period. subroutine update_OBC_ramp(Time, OBC, activate) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure logical, optional, intent(in) :: activate !< Specifiy whether to record the value of !! Time as the beginning of the ramp period @@ -4582,7 +4571,7 @@ subroutine segment_tracer_registry_end(Reg) if (associated(Reg)) then do n = 1, Reg%ntseg - if (associated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) + if (allocated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) enddo deallocate(Reg) endif @@ -4623,12 +4612,11 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments subroutine fill_temp_salt_segments(G, GV, OBC, tv) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure -! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz integer :: i, j, k type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -4946,15 +4934,6 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart call MOM_error(FATAL, "open_boundary_register_restarts: Called with "//& "uninitialized OBC control structure") - if (associated(OBC%rx_normal) .or. associated(OBC%ry_normal) .or. & - associated(OBC%rx_oblique) .or. associated(OBC%ry_oblique) .or. associated(OBC%cff_normal)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - - if (associated(OBC%tres_x) .or. associated(OBC%tres_y)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - ! *** This is a temporary work around for restarts with OBC segments. ! This implementation uses 3D arrays solely for restarts. We need ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using @@ -4984,7 +4963,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart endif if (Reg%ntr == 0) return - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then OBC%ntr = Reg%ntr allocate(OBC%tracer_x_reservoirs_used(Reg%ntr), source=.false.) allocate(OBC%tracer_y_reservoirs_used(Reg%ntr), source=.false.) @@ -5046,7 +5025,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, intent(in) :: dt !< time increment [T ~> s] type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - ! Local variables + type(OBC_segment_type), pointer :: segment=>NULL() real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell [L ~> m] @@ -5072,7 +5051,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_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 / & @@ -5081,7 +5060,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) - if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) + if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif ; enddo enddo elseif (segment%is_N_or_S) then @@ -5097,7 +5076,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_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 / & @@ -5106,7 +5085,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) - if (associated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) + if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) enddo ; endif ; enddo enddo endif @@ -5123,12 +5102,12 @@ end subroutine update_segment_tracer_reservoirs !! @remark{There is a (hard-wired) "tolerance" parameter such that the !! criteria for adjustment must equal or exceed 10cm.} subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) - 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(OBC_segment_type), intent(inout) :: segment !< pointer to segment type - integer, intent(in) :: fld !< field index to adjust thickness - ! Local variables + 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(OBC_segment_type), intent(inout) :: segment !< OBC segment + integer, intent(in) :: fld !< field index to adjust thickness + integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] @@ -5434,7 +5413,7 @@ end subroutine rotate_OBC_segment_config !> Initialize the segments and field-related data of a rotated OBC. subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) - type(ocean_OBC_type), pointer, intent(in) :: OBC_in !< OBC on input map + type(ocean_OBC_type), intent(in) :: OBC_in !< OBC on input map type(ocean_grid_type), intent(in) :: G !< Rotated grid metric type(verticalGrid_type), intent(in) :: GV !< Vertical grid type(unit_scale_type), intent(in) :: US !< Unit scaling @@ -5523,7 +5502,6 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns) segment%field(n)%dz_src) endif - segment%field(n)%buffer_dst => NULL() segment%field(n)%value = segment_in%field(n)%value enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 37acb8ca42..dfcd097be0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -630,7 +630,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "OBC_USER_CONFIG = "//trim(config)//" have not been fully implemented.") endif if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) + call set_tracer_data(OBC, tv, h, G, GV, PF) endif endif ! if (open_boundary_query(OBC, apply_nudged_OBC=.true.)) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index be4c059982..34c8dddf04 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -450,7 +450,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then I = segment%HI%IsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_W) then T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -594,7 +594,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = uhr(I,j,k) ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else ; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -617,7 +617,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then uhh(I) = uhr(I,j,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif enddo @@ -821,7 +821,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (i>=segment%HI%isd .and. i<=segment%HI%ied) then J = segment%HI%JsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_S) then T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -966,7 +966,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -989,7 +989,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 8599272e32..ee4491799a 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -256,7 +256,7 @@ subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) ! Store this information for use in setting up the OBC restarts for tracer reservoirs. OBC%ntr = tr_Reg%ntr - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then allocate(OBC%tracer_x_reservoirs_used(OBC%ntr)) allocate(OBC%tracer_y_reservoirs_used(OBC%ntr)) OBC%tracer_x_reservoirs_used(:) = .false. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index fe5168ab7e..9bdf9b45c3 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -287,7 +287,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB+1,JedB-1 ; do I=IsdB,IedB x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J) @@ -343,7 +343,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB,JedB ; do I=IsdB+1,IedB-1 x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J)