From 4ab93b69dfa0858d6f0d46c211a2d4f9917eafe0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 2 Dec 2020 11:25:06 -0500 Subject: [PATCH] +Deprecate the use of G%ke, using GV%ke instead Use GV%ke instead of G%ke everywhere in the MOM6 code to get the number of layers in a configuration. This required the addition of new vertical_grid_type arguments to a number of subroutines, and some unused variables were deleted. This is one of the final steps in a very long-term project to separate the vertical and horizontal grid types. All answers are bitwise identical, but there are new (non-optional) arguments to 51 subroutines. --- src/ALE/MOM_ALE.F90 | 4 +- src/core/MOM.F90 | 18 +- src/core/MOM_CoriolisAdv.F90 | 17 +- src/core/MOM_PressureForce_FV.F90 | 4 +- src/core/MOM_PressureForce_Montgomery.F90 | 12 +- src/core/MOM_barotropic.F90 | 16 +- src/core/MOM_boundary_update.F90 | 22 +- src/core/MOM_checksum_packages.F90 | 15 +- src/core/MOM_continuity_PPM.F90 | 70 +++--- src/core/MOM_dynamics_split_RK2.F90 | 28 +-- src/core/MOM_dynamics_unsplit.F90 | 18 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 14 +- src/core/MOM_forcing_type.F90 | 12 +- src/core/MOM_interface_heights.F90 | 4 +- src/core/MOM_isopycnal_slopes.F90 | 2 +- src/core/MOM_open_boundary.F90 | 172 ++++++++------- src/core/MOM_variables.F90 | 18 +- src/diagnostics/MOM_PointAccel.F90 | 4 +- src/diagnostics/MOM_diagnostics.F90 | 17 +- src/diagnostics/MOM_sum_output.F90 | 44 ++-- src/diagnostics/MOM_wave_speed.F90 | 4 +- src/diagnostics/MOM_wave_structure.F90 | 7 +- src/framework/MOM_diag_mediator.F90 | 7 +- src/framework/MOM_diag_remap.F90 | 2 +- .../MOM_state_initialization.F90 | 204 +++++++++--------- .../MOM_tracer_initialization_from_Z.F90 | 26 +-- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- .../lateral/MOM_hor_visc.F90 | 21 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 28 +-- .../vertical/MOM_ALE_sponge.F90 | 41 ++-- .../vertical/MOM_CVMix_KPP.F90 | 118 +++++----- .../vertical/MOM_CVMix_ddiff.F90 | 14 +- .../vertical/MOM_CVMix_shear.F90 | 36 ++-- .../vertical/MOM_bkgnd_mixing.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 22 +- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_diapyc_energy_req.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 8 +- .../vertical/MOM_full_convection.F90 | 4 +- .../vertical/MOM_geothermal.F90 | 4 +- .../vertical/MOM_internal_tide_input.F90 | 4 +- .../vertical/MOM_opacity.F90 | 8 +- .../vertical/MOM_regularize_layers.F90 | 6 +- .../vertical/MOM_set_diffusivity.F90 | 20 +- .../vertical/MOM_set_viscosity.F90 | 4 +- src/parameterizations/vertical/MOM_sponge.F90 | 6 +- .../vertical/MOM_tidal_mixing.F90 | 69 +++--- .../vertical/MOM_vert_friction.F90 | 16 +- src/tracer/ISOMIP_tracer.F90 | 4 +- src/tracer/MOM_OCMIP2_CFC.F90 | 13 +- src/tracer/MOM_generic_tracer.F90 | 29 +-- src/tracer/MOM_lateral_boundary_diffusion.F90 | 6 +- src/tracer/MOM_neutral_diffusion.F90 | 41 ++-- src/tracer/MOM_offline_main.F90 | 28 +-- src/tracer/MOM_tracer_Z_init.F90 | 12 +- src/tracer/MOM_tracer_diabatic.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 5 +- src/tracer/MOM_tracer_hor_diff.F90 | 5 +- src/tracer/MOM_tracer_registry.F90 | 17 +- src/tracer/RGC_tracer.F90 | 4 +- src/tracer/ideal_age_example.F90 | 4 +- src/tracer/oil_tracer.F90 | 4 +- src/user/BFB_initialization.F90 | 2 +- src/user/DOME2d_initialization.F90 | 22 +- src/user/DOME_initialization.F90 | 6 +- src/user/ISOMIP_initialization.F90 | 8 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 36 ++-- src/user/Neverworld_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 6 +- src/user/RGC_initialization.F90 | 11 +- src/user/Rossby_front_2d_initialization.F90 | 6 +- src/user/SCM_CVMix_tests.F90 | 2 +- src/user/adjustment_initialization.F90 | 4 +- src/user/baroclinic_zone_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 4 +- src/user/circle_obcs_initialization.F90 | 4 +- src/user/dense_water_initialization.F90 | 2 +- src/user/dumbbell_initialization.F90 | 6 +- src/user/dyed_channel_initialization.F90 | 5 +- src/user/dyed_obcs_initialization.F90 | 2 +- src/user/external_gwave_initialization.F90 | 2 +- src/user/lock_exchange_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 4 +- src/user/shelfwave_initialization.F90 | 12 +- src/user/sloshing_initialization.F90 | 14 +- src/user/soliton_initialization.F90 | 7 +- src/user/supercritical_initialization.F90 | 15 +- src/user/tidal_bay_initialization.F90 | 17 +- src/user/user_change_diffusivity.F90 | 2 +- src/user/user_initialization.F90 | 9 +- 94 files changed, 815 insertions(+), 799 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index f130c2977a..c1042107ec 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -483,7 +483,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) dzRegrid(:,:,:) = 0.0 h_new(:,:,:) = 0.0 - if (debug) call MOM_tracer_chkinv("Before ALE_offline_inputs", G, h, Reg%Tr, Reg%ntr) + if (debug) call MOM_tracer_chkinv("Before ALE_offline_inputs", G, GV, h, Reg%Tr, Reg%ntr) ! Build new grid from the Zstar state onto the requested vertical coordinate. The new grid is stored ! in h_new. The old grid is h. Both are needed for the subsequent remapping of variables. Convective @@ -526,7 +526,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%T, h_new, tv%T, answers_2018=CS%answers_2018) call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%S, h_new, tv%S, answers_2018=CS%answers_2018) - if (debug) call MOM_tracer_chkinv("After ALE_offline_inputs", G, h_new, Reg%Tr, Reg%ntr) + if (debug) call MOM_tracer_chkinv("After ALE_offline_inputs", G, GV, h_new, Reg%Tr, Reg%ntr) ! Copy over the new layer thicknesses do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0e736e7312..4da7f66e85 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -505,7 +505,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS integer :: turns ! Number of quarter turns from input to model indexing G => CS%G ; G_in => CS%G_in ; GV => CS%GV ; US => CS%US - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -982,7 +982,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB G => CS%G ; GV => CS%GV ; US => CS%US ; IDs => CS%IDs - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -1237,7 +1237,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & integer :: halo_sz ! The size of a halo where data must be valid. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_thermo(), MOM.F90") @@ -2400,7 +2400,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif if (associated(ALE_sponge_in_CSp)) then - call rotate_ALE_sponge(ALE_sponge_in_CSp, G_in, CS%ALE_sponge_CSp, G, turns, param_file) + call rotate_ALE_sponge(ALE_sponge_in_CSp, G_in, CS%ALE_sponge_CSp, G, GV, turns, param_file) call update_ALE_sponge_field(CS%ALE_sponge_CSp, T_in, G, GV, CS%T) call update_ALE_sponge_field(CS%ALE_sponge_CSp, S_in, G, GV, CS%S) endif @@ -2535,8 +2535,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call diag_update_remap_grids(diag) ! Setup the diagnostic grid storage types - call diag_grid_storage_init(CS%diag_pre_sync, G, diag) - call diag_grid_storage_init(CS%diag_pre_dyn, G, diag) + call diag_grid_storage_init(CS%diag_pre_sync, G, GV, diag) + call diag_grid_storage_init(CS%diag_pre_dyn, G, GV, diag) ! Calculate masks for diagnostics arrays in non-native coordinates ! This step has to be done after set_axes_info() because the axes needed @@ -2630,7 +2630,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call tracer_advect_init(Time, G, US, param_file, diag, CS%tracer_adv_CSp) - call tracer_hor_diff_init(Time, G, US, param_file, diag, CS%tv%eqn_of_state, CS%diabatic_CSp, & + call tracer_hor_diff_init(Time, G, GV, US, param_file, diag, CS%tv%eqn_of_state, CS%diabatic_CSp, & CS%tracer_diff_CSp) call lock_tracer_registry(CS%tracer_Reg) @@ -2748,7 +2748,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%nstep_tot = 0 if (present(count_calls)) CS%count_calls = count_calls - call MOM_sum_output_init(G_in, US, param_file, dirs%output_directory, & + call MOM_sum_output_init(G_in, GV, US, param_file, dirs%output_directory, & CS%ntrunc, Time_init, CS%sum_output_CSp) ! Flag whether to save initial conditions in finish_MOM_initialization() or not. @@ -3343,7 +3343,7 @@ subroutine extract_surface_state(CS, sfc_state_in) endif if (associated(CS%tracer_flow_CSp)) then - call call_tracer_surface_state(sfc_state, h, G, CS%tracer_flow_CSp) + call call_tracer_surface_state(sfc_state, h, G, GV, CS%tracer_flow_CSp) endif if (CS%check_bad_sfc_vals) then diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e6a7f7698f..10a6ecf3ac 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -233,7 +233,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) 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 = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke h_neglect = GV%H_subroundoff eps_vel = 1.0e-10*US%m_s_to_L_T h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. @@ -580,7 +580,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif ! Calculate KE and the gradient of KE - call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) + call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) ! Calculate the tendencies of zonal velocity due to the Coriolis ! force and momentum advection. On a Cartesian grid, this is @@ -848,7 +848,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. ! The code is retained for degugging purposes in the future. !if (CS%id_hf_gKEu > 0) then - ! allocate(hf_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) + ! allocate(hf_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq ! hf_gKEu(I,j,k) = AD%gradKEu(I,j,k) * AD%diag_hfrac_u(I,j,k) ! enddo ; enddo ; enddo @@ -856,7 +856,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !endif !if (CS%id_hf_gKEv > 0) then - ! allocate(hf_gKEv(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) + ! allocate(hf_gKEv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie ! hf_gKEv(i,J,k) = AD%gradKEv(i,J,k) * AD%diag_hfrac_v(i,J,k) ! enddo ; enddo ; enddo @@ -884,7 +884,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif !if (CS%id_hf_rvxv > 0) then - ! allocate(hf_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) + ! allocate(hf_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq ! hf_rvxv(I,j,k) = AD%rv_x_v(I,j,k) * AD%diag_hfrac_u(I,j,k) ! enddo ; enddo ; enddo @@ -892,7 +892,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !endif !if (CS%id_hf_rvxu > 0) then - ! allocate(hf_rvxu(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) + ! allocate(hf_rvxu(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie ! hf_rvxu(i,J,k) = AD%rv_x_u(i,J,k) * AD%diag_hfrac_v(i,J,k) ! enddo ; enddo ; enddo @@ -924,8 +924,9 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. -subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) +subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -944,7 +945,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) real :: um2a, up2a, vm2a, vp2a ! Temporary variables [L4 T-2 ~> m4 s-2]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 4fd1b583d3..f6be2d360d 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -154,7 +154,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke nkmb=GV%nk_rho_varies 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) @@ -490,7 +490,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke nkmb=GV%nk_rho_varies 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) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index cade4e074d..b09805b347 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -128,7 +128,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke nkmb=GV%nk_rho_varies 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) @@ -415,7 +415,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke nkmb=GV%nk_rho_varies 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) @@ -638,7 +638,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) Rho0xG = Rho0 * GV%g_Earth @@ -740,7 +740,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) use_EOS = associated(tv%eqn_of_state) @@ -864,11 +864,11 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ 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,G%ke) + 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,G%ke) + call safe_alloc_ptr(CS%PFv_bc,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) CS%PFv_bc(:,:,:) = 0.0 endif endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5e42a9575f..0cc1ab505c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -694,7 +694,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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 = G%ke + 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -2696,7 +2696,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) 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 = G%ke + 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 if (.not.(present(pbce) .or. present(gtot_est))) call MOM_error(FATAL, & @@ -3006,7 +3006,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B type(OBC_segment_type), pointer :: segment !< Open boundary segment is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 isdw = MS%isdw ; iedw = MS%iedw ; jsdw = MS%jsdw ; jedw = MS%jedw @@ -3249,7 +3249,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) apply_OBCs = (OBC%number_of_segments > 0) endif ; endif ; endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB h_neglect = GV%H_subroundoff @@ -4168,7 +4168,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) "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 = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke !$OMP parallel do default(shared) private(eta_h,h_tot,d_eta) do j=js,je @@ -4271,7 +4271,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, integer :: wd_halos(2), bt_halo_sz isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed @@ -4580,7 +4580,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call do_group_pass(pass_a_polarity, CS%BT_domain) if (use_BT_cont_type) & - call alloc_BT_cont_type(BT_cont, G, (CS%hvel_scheme == FROM_BT_CONT)) + call alloc_BT_cont_type(BT_cont, G, GV, (CS%hvel_scheme == FROM_BT_CONT)) if (CS%debug) then ! Make a local copy of loop ranges for chksum calls allocate(CS%debug_BT_HI) @@ -4698,7 +4698,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo + do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra) if (dtbt_input > 0.0) then diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index d7ab6a1922..658a2d7ccf 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -14,9 +14,9 @@ module MOM_boundary_update use MOM_open_boundary, only : OBC_registry_type, file_OBC_CS use MOM_open_boundary, only : register_file_OBC, file_OBC_end use MOM_unit_scaling, only : unit_scale_type -use MOM_verticalGrid, only : verticalGrid_type use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type 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 Kelvin_initialization, only : Kelvin_set_OBC_data, register_Kelvin_OBC @@ -120,31 +120,17 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) type(update_OBC_CS), pointer :: CS !< Control structure for OBCs type(time_type), intent(in) :: Time !< Model time - ! Local variables - logical :: read_OBC_eta = .false. - logical :: read_OBC_uv = .false. - logical :: read_OBC_TS = .false. - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: isd_off, jsd_off - integer :: IsdB, IedB, JsdB, JedB - character(len=40) :: mdl = "update_OBC_data" ! This subroutine's name. - character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - ! Something here... with CS%file_OBC_CSp? ! 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, h, Time) + call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, 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) & - call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, h, Time) + call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, GV, h, Time) if (CS%use_dyed_channel) & - call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, Time) + call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, Time) if (OBC%needs_IO_for_data .or. OBC%add_tide_constituents) & call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 70ba32644f..ae53a4086d 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -64,8 +64,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy real :: scale_vel ! The scaling factor to convert velocities to [m s-1] logical :: sym - integer :: is, ie, js, je, nz, hs - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: hs ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie @@ -99,10 +98,9 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> nondim] or [nondim] - integer :: is, ie, js, je, nz, hs + integer :: hs logical :: sym - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke L_T_to_m_s = 1.0 ; if (present(US)) L_T_to_m_s = US%L_T_to_m_s ! Note that for the chksum calls to be useful for reproducing across PE @@ -125,9 +123,8 @@ subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). - integer :: is, ie, js, je, nz, hs - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - hs=1; if (present(haloshift)) hs=haloshift + integer :: hs + hs=1 ; if (present(haloshift)) hs=haloshift if (associated(tv%T)) call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs) if (associated(tv%S)) call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs) @@ -214,10 +211,8 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computational domain. - integer :: is, ie, js, je, nz logical :: sym - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke sym=.false.; if (present(symmetric)) sym=symmetric ! Note that for the chksum calls to be useful for reproducing across PE @@ -277,7 +272,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe character(len=80) :: lMsg integer :: is, ie, js, je, nz, i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do_TS = associated(Temp) .and. associated(Salt) tmp_A(:,:) = 0.0 diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 995827959d..1f9a2c3bbd 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -76,6 +76,7 @@ module MOM_continuity_PPM subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -90,7 +91,6 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & 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(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces @@ -131,7 +131,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O integer :: i, j, k logical :: x_first - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_min = GV%Angstrom_H @@ -277,7 +277,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & local_Flather_OBC = OBC%Flather_u_BCs_exist_globally local_open_BC = OBC%open_u_BCs_exist_globally endif ; endif - ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke + ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = GV%ke CFL_dt = CS%CFL_limit_adjust / dt I_dt = 1.0 / dt @@ -429,7 +429,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (present(uhbt)) then call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, duhdu_tot_0, du, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & j, ish, ieh, do_I, .true., uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz @@ -448,7 +448,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (set_BT_cont) then call set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,& - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -507,10 +507,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then if (present(u_cor)) then - call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, US, LB, & + call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, GV, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) else - call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, US, LB, & + call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, GV, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) endif endif ; endif @@ -600,9 +600,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & end subroutine zonal_flux_layer !> Sets the effective interface thickness at each zonal velocity point. -subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, US, LB, vol_CFL, & +subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, & marginal, visc_rem_u, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. @@ -634,7 +635,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, US, LB, vol_CFL, & real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC integer :: i, j, k, ish, ieh, jsh, jeh, nz, n - ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke + ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = GV%ke !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh @@ -708,9 +709,10 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. @@ -768,7 +770,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZIB_(G)) - nz = G%ke + nz = GV%ke full_prec = .true. ; if (present(full_precision)) full_prec = full_precision uh_aux(:,:) = 0.0 ; duhdu(:,:) = 0.0 @@ -872,9 +874,10 @@ end subroutine zonal_flux_adjust !> Sets a structure that describes the zonal barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. @@ -940,13 +943,13 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0 / dt + nz = GV%ke ; Idt = 1.0 / dt min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently @@ -1101,7 +1104,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & local_Flather_OBC = OBC%Flather_v_BCs_exist_globally local_open_BC = OBC%open_v_BCs_exist_globally endif ; endif ; endif - ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke + ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = GV%ke CFL_dt = CS%CFL_limit_adjust / dt I_dt = 1.0 / dt @@ -1249,7 +1252,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (present(vhbt)) then call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & j, ish, ieh, do_I, .true., vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz @@ -1267,7 +1270,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (set_BT_cont) then call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,& - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1326,10 +1329,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then if (present(v_cor)) then - call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, US, LB, & + call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, GV, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) else - call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, US, LB, & + call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, GV, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) endif endif ; endif @@ -1423,9 +1426,10 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & end subroutine merid_flux_layer !> Sets the effective interface thickness at each meridional velocity point. -subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, US, LB, vol_CFL, & +subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. @@ -1457,7 +1461,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, US, LB, vol_CFL, & real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke + ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = GV%ke !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh @@ -1532,17 +1536,18 @@ end subroutine merid_face_thickness !> Returns the barotropic velocity adjustment that gives the desired barotropic (layer-summed) transport. subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & - dv, dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) - type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. + intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - intent(in) :: h_L !< Left thickness in the reconstruction [H ~> m or kg m-2]. + intent(in) :: h_L !< Left thickness in the reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_R !< Right thickness in the reconstruction [H ~> m or kg m-2]. + intent(in) :: h_R !< Right thickness in the reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the momentum originally !! in a layer that remains after a time-step of viscosity, and the @@ -1591,7 +1596,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZI_(G)) - nz = G%ke + nz = GV%ke full_prec = .true. ; if (present(full_precision)) full_prec = full_precision vh_aux(:,:) = 0.0 ; dvhdv(:,:) = 0.0 @@ -1695,9 +1700,10 @@ end subroutine meridional_flux_adjust !> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. @@ -1763,13 +1769,13 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0 / dt + nz = GV%ke ; Idt = 1.0 / dt min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently @@ -2273,7 +2279,7 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) "tolerance for SSH is 4 times this value. The default "//& "is 0.5*NK*ANGSTROM, and this should not be set less "//& "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & - default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) + default=0.5*GV%ke*GV%Angstrom_m, unscaled=tol_eta_m) !### ETA_TOLERANCE_AUX can be obsoleted. call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 64a9c18b97..50b893dae7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -348,7 +348,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: cont_stencil - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta @@ -445,7 +445,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC) .and. CS%debug_OBC) & - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%PFu, CS%PFv) if (G%nonblocking_updates) & call start_group_pass(CS%pass_eta, G%Domain, clock=id_clock_pass) @@ -469,7 +469,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, u_bc_accel, v_bc_accel) endif call cpu_clock_end(id_clock_btforce) @@ -631,7 +631,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, GV, US, dt_pred) if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -727,7 +727,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, u_bc_accel, v_bc_accel) endif call cpu_clock_end(id_clock_btforce) @@ -840,7 +840,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, GV, US, dt) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -885,14 +885,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. ! The code is retained for degugging purposes in the future. !if (CS%id_hf_PFu > 0) then - ! allocate(hf_PFu(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) + ! allocate(hf_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq ! hf_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) ! enddo ; enddo ; enddo ! call post_data(CS%id_hf_PFu, hf_PFu, CS%diag) !endif !if (CS%id_hf_PFv > 0) then - ! allocate(hf_PFv(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) + ! allocate(hf_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie ! hf_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) ! enddo ; enddo ; enddo @@ -918,14 +918,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif !if (CS%id_hf_CAu > 0) then - ! allocate(hf_CAu(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) + ! allocate(hf_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq ! hf_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) ! enddo ; enddo ; enddo ! call post_data(CS%id_hf_CAu, hf_CAu, CS%diag) !endif !if (CS%id_hf_CAv > 0) then - ! allocate(hf_CAv(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) + ! allocate(hf_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie ! hf_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) ! enddo ; enddo ; enddo @@ -951,14 +951,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif !if (CS%id_hf_u_BT_accel > 0) then - ! allocate(hf_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) + ! allocate(hf_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq ! hf_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) ! enddo ; enddo ; enddo ! call post_data(CS%id_hf_u_BT_accel, hf_u_BT_accel, CS%diag) !endif !if (CS%id_hf_v_BT_accel > 0) then - ! allocate(hf_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) + ! allocate(hf_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie ! hf_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) ! enddo ; enddo ; enddo @@ -1137,7 +1137,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -1233,7 +1233,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, 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_CSp, MEKE, 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, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6b9aa8e759..a129e71465 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -235,7 +235,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real :: dt_visc ! The time step for a part of the update due to viscosity [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 dt_pred = dt / 3.0 @@ -320,8 +320,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) - call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%PFu, CS%PFv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) endif ! up = u + dt_pred * (PFu + CAu) @@ -386,8 +386,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) - call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%PFu, CS%PFv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) endif ! upp = u + dt/2 * ( PFu + CAu ) @@ -463,8 +463,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u = u + dt * ( PFu + CAu ) if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) - call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%PFu, CS%PFv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * (CS%PFu(I,j,k) + CS%CAu(I,j,k))) @@ -617,7 +617,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS real :: H_convert logical :: use_tides integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 (.not.associated(CS)) call MOM_error(FATAL, & @@ -661,7 +661,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, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) 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 4181ab519d..307874eb14 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -245,7 +245,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real :: dt_visc ! The time step for a part of the update due to viscosity [T ~> s] logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 dt_pred = dt * CS%BE @@ -315,9 +315,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call update_OBC_data(CS%OBC, G, GV, US, tv, h_in, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) - call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) - call open_boundary_zero_normal_flow(CS%OBC, G, CS%diffu, CS%diffv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%PFu, CS%PFv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%diffu, CS%diffv) endif ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) @@ -371,7 +371,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) + call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) endif ! call enable_averages(dt, Time_local, CS%diag) ?????????????????????/ @@ -563,7 +563,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag real :: H_convert logical :: use_tides integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 (.not.associated(CS)) call MOM_error(FATAL, & @@ -623,7 +623,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, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) 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_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index ed4b8d1ba2..dd7559aeac 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -460,7 +460,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & I_Cp = 1.0 / fluxes%C_p I_Cp_Hconvert = 1.0 / (GV%H_to_RZ * fluxes%C_p) - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke calculate_diags = .true. if (present(skip_diags)) calculate_diags = .not. skip_diags @@ -972,7 +972,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt buoyancyFlux(G%isc:G%iec,1) = - GoRho * ( dRhodS(G%isc:G%iec) * netSalt(G%isc:G%iec) + & dRhodT(G%isc:G%iec) * netHeat(G%isc:G%iec) ) ! [L2 T-3 ~> m2 s-3] ! We also have a penetrative buoyancy flux associated with penetrative SW - do k=2, G%ke+1 + do k=2, GV%ke+1 buoyancyFlux(G%isc:G%iec,k) = - GoRho * ( dRhodT(G%isc:G%iec) * netPen(G%isc:G%iec,k) ) ! [L2 T-3 ~> m2 s-3] enddo @@ -1025,8 +1025,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< shift in halo - integer :: is, ie, js, je, nz, hshift - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: hshift hshift = 1 ; if (present(haloshift)) hshift = haloshift @@ -1119,10 +1118,9 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< shift in halo - integer :: is, ie, js, je, nz, hshift - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: hshift - hshift=1; if (present(haloshift)) hshift=haloshift + hshift = 1 ; if (present(haloshift)) hshift = haloshift ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index b8cf161148..d016b962d4 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -60,7 +60,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) isv = G%isc-halo ; iev = G%iec+halo ; jsv = G%jsc-halo ; jev = G%jec+halo - nz = G%ke + nz = GV%ke if ((isvG%ied) .or. (jsvG%jed)) & call MOM_error(FATAL,"find_eta called with an overly large halo_size.") @@ -174,7 +174,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - nz = G%ke + nz = GV%ke Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index c134366cd0..68a4373314 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -113,7 +113,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & else is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec endif - nz = G%ke ; IsdB = G%IsdB + nz = GV%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 46d144a8c6..3c6ada5fd1 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2076,8 +2076,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) end subroutine open_boundary_impose_land_mask !> Make sure the OBC tracer reservoirs are initialized. -subroutine setup_OBC_tracer_reservoirs(G, OBC) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure +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(OBC_segment_type), pointer :: segment => NULL() @@ -2090,7 +2091,7 @@ subroutine setup_OBC_tracer_reservoirs(G, OBC) I = segment%HI%IsdB do m=1,OBC%ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then - do k=1,G%ke + 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) enddo @@ -2101,7 +2102,7 @@ subroutine setup_OBC_tracer_reservoirs(G, OBC) J = segment%HI%JsdB do m=1,OBC%ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then - do k=1,G%ke + 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) enddo @@ -2114,10 +2115,11 @@ subroutine setup_OBC_tracer_reservoirs(G, OBC) end subroutine setup_OBC_tracer_reservoirs -!> Apply radiation conditions to 3D u,v at open boundaries -subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure +!> Apply radiation conditions to 3D u,v at open boundaries +subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, dt) + 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 control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries !! On entry, the old time-level v but including !! barotropic accelerations [L T-1 ~> m s-1]. @@ -2149,7 +2151,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) integer :: i, j, k, is, ie, js, je, m, nz, n integer :: is_obc, ie_obc, js_obc, je_obc - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(OBC)) return @@ -2166,14 +2168,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment=>OBC%segment(n) if (.not. segment%on_pe) cycle if (segment%is_E_or_W .and. segment%radiation) then - do k=1,G%ke + do k=1,GV%ke I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed segment%rx_norm_rad(I,j,k) = OBC%rx_normal(I,j,k) enddo enddo elseif (segment%is_N_or_S .and. segment%radiation) then - do k=1,G%ke + do k=1,GV%ke J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied segment%ry_norm_rad(i,J,k) = OBC%ry_normal(i,J,k) @@ -2181,7 +2183,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) enddo endif if (segment%is_E_or_W .and. segment%oblique) then - do k=1,G%ke + do k=1,GV%ke I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed segment%rx_norm_obl(I,j,k) = OBC%rx_oblique(I,j,k) @@ -2190,7 +2192,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) enddo enddo elseif (segment%is_N_or_S .and. segment%oblique) then - do k=1,G%ke + do k=1,GV%ke J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied segment%rx_norm_obl(i,J,k) = OBC%rx_oblique(i,J,k) @@ -2210,7 +2212,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) I = segment%HI%IsdB do m=1,OBC%ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then - do k=1,G%ke + 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) enddo @@ -2221,7 +2223,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) J = segment%HI%JsdB do m=1,OBC%ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then - do k=1,G%ke + 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) enddo @@ -2237,7 +2239,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G, segment, u_new(:,:,:), v_new(:,:,:)) + if (segment%oblique) call gradient_at_q_points(G, GV, segment, u_new(:,:,:), v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I Applies OBC values stored in segments to 3d u,v fields -subroutine open_boundary_apply_normal_flow(OBC, G, u, v) +subroutine open_boundary_apply_normal_flow(OBC, G, GV, u, v) ! Arguments type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open !! boundaries [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open @@ -3246,12 +3249,12 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) elseif (segment%radiation .or. segment%oblique .or. segment%gradient) then if (segment%is_E_or_W) then I=segment%HI%IsdB - do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed + do k=1,GV%ke ; do j=segment%HI%jsd,segment%HI%jed u(I,j,k) = segment%normal_vel(I,j,k) enddo ; enddo elseif (segment%is_N_or_S) then J=segment%HI%JsdB - do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied + do k=1,GV%ke ; do i=segment%HI%isd,segment%HI%ied v(i,J,k) = segment%normal_vel(i,J,k) enddo ; enddo endif @@ -3261,10 +3264,11 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) end subroutine open_boundary_apply_normal_flow !> Applies zero values to 3d u,v fields on OBC segments -subroutine open_boundary_zero_normal_flow(OBC, G, u, v) +subroutine open_boundary_zero_normal_flow(OBC, G, GV, u, v) ! Arguments type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open boundaries real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries ! Local variables @@ -3279,12 +3283,12 @@ subroutine open_boundary_zero_normal_flow(OBC, G, u, v) cycle elseif (segment%is_E_or_W) then I=segment%HI%IsdB - do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed + do k=1,GV%ke ; do j=segment%HI%jsd,segment%HI%jed u(I,j,k) = 0. enddo ; enddo elseif (segment%is_N_or_S) then J=segment%HI%JsdB - do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied + do k=1,GV%ke ; do i=segment%HI%isd,segment%HI%ied v(i,J,k) = 0. enddo ; enddo endif @@ -3293,9 +3297,10 @@ subroutine open_boundary_zero_normal_flow(OBC, G, u, v) end subroutine open_boundary_zero_normal_flow !> Calculate the tangential gradient of the normal flow at the boundary q-points. -subroutine gradient_at_q_points(G, segment, uvel, vvel) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(OBC_segment_type), pointer :: segment !< OBC segment structure +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 real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k @@ -3305,14 +3310,14 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%is_E_or_W) then if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%isdB - do k=1,G%ke + do k=1,GV%ke do J=max(segment%HI%JsdB, G%HI%JsdB+1),min(segment%HI%JedB, G%HI%JedB-1) segment%grad_normal(J,1,k) = (uvel(I-1,j+1,k)-uvel(I-1,j,k)) * G%mask2dBu(I-1,J) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo if (segment%oblique_tan) then - do k=1,G%ke + do k=1,GV%ke do J=max(segment%HI%jsd-1, G%HI%jsd),min(segment%HI%jed+1, G%HI%jed) segment%grad_tan(j,1,k) = (vvel(i-1,J,k)-vvel(i-1,J-1,k)) * G%mask2dT(i-1,j) segment%grad_tan(j,2,k) = (vvel(i,J,k)-vvel(i,J-1,k)) * G%mask2dT(i,j) @@ -3320,7 +3325,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) enddo endif if (segment%oblique_grad) then - do k=1,G%ke + do k=1,GV%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-2,j) @@ -3331,14 +3336,14 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) endif else ! western segment I=segment%HI%isdB - do k=1,G%ke + do k=1,GV%ke do J=max(segment%HI%JsdB, G%HI%JsdB+1),min(segment%HI%JedB, G%HI%JedB-1) segment%grad_normal(J,1,k) = (uvel(I+1,j+1,k)-uvel(I+1,j,k)) * G%mask2dBu(I+1,J) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo if (segment%oblique_tan) then - do k=1,G%ke + do k=1,GV%ke do J=max(segment%HI%jsd-1, G%HI%jsd),min(segment%HI%jed+1, G%HI%jed) segment%grad_tan(j,1,k) = (vvel(i+2,J,k)-vvel(i+2,J-1,k)) * G%mask2dT(i+2,j) segment%grad_tan(j,2,k) = (vvel(i+1,J,k)-vvel(i+1,J-1,k)) * G%mask2dT(i+1,j) @@ -3346,7 +3351,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) enddo endif if (segment%oblique_grad) then - do k=1,G%ke + do k=1,GV%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) @@ -3359,14 +3364,14 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) elseif (segment%is_N_or_S) then if (segment%direction == OBC_DIRECTION_N) then J=segment%HI%jsdB - do k=1,G%ke + do k=1,GV%ke do I=max(segment%HI%IsdB, G%HI%IsdB+1),min(segment%HI%IedB, G%HI%IedB-1) segment%grad_normal(I,1,k) = (vvel(i+1,J-1,k)-vvel(i,J-1,k)) * G%mask2dBu(I,J-1) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo if (segment%oblique_tan) then - do k=1,G%ke + do k=1,GV%ke do I=max(segment%HI%isd-1, G%HI%isd),min(segment%HI%ied+1, G%HI%ied) segment%grad_tan(i,1,k) = (uvel(I,j-1,k)-uvel(I-1,j-1,k)) * G%mask2dT(i,j-1) segment%grad_tan(i,2,k) = (uvel(I,j,k)-uvel(I-1,j,k)) * G%mask2dT(i,j) @@ -3374,7 +3379,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) enddo endif if (segment%oblique_grad) then - do k=1,G%ke + do k=1,GV%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdyBu(I,J-2)) - & (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdyBu(I-1,J-2)) * G%mask2dCv(i,J-2) @@ -3385,14 +3390,14 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) endif else ! south segment J=segment%HI%jsdB - do k=1,G%ke + do k=1,GV%ke do I=max(segment%HI%IsdB, G%HI%IsdB+1),min(segment%HI%IedB, G%HI%IedB-1) segment%grad_normal(I,1,k) = (vvel(i+1,J+1,k)-vvel(i,J+1,k)) * G%mask2dBu(I,J+1) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo if (segment%oblique_tan) then - do k=1,G%ke + do k=1,GV%ke do I=max(segment%HI%isd-1, G%HI%isd),min(segment%HI%ied+1, G%HI%ied) segment%grad_tan(i,1,k) = (uvel(I,j+2,k)-uvel(I-1,j+2,k)) * G%mask2dT(i,j+2) segment%grad_tan(i,2,k) = (uvel(I,j+1,k)-uvel(I-1,j+1,k)) * G%mask2dT(i,j+1) @@ -3400,7 +3405,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) enddo endif if (segment%oblique_grad) then - do k=1,G%ke + do k=1,GV%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdyBu(I,J+2)) - & (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) @@ -3417,8 +3422,9 @@ 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, PF, tracer_Reg) +subroutine set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) 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_(G)), intent(inout) :: h !< Thickness @@ -3435,7 +3441,7 @@ subroutine set_tracer_data(OBC, tv, h, G, PF, tracer_Reg) real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) real :: temp_v(G%domain%niglobal,G%domain%njglobal+1) - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -3454,22 +3460,22 @@ subroutine set_tracer_data(OBC, tv, h, G, PF, tracer_Reg) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB - do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed + do k=1,GV%ke ; do j=segment%HI%jsd,segment%HI%jed tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) enddo ; enddo elseif (segment%direction == OBC_DIRECTION_W) then I=segment%HI%IsdB - do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed + do k=1,GV%ke ; do j=segment%HI%jsd,segment%HI%jed tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) enddo ; enddo elseif (segment%direction == OBC_DIRECTION_N) then J=segment%HI%JsdB - do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied + do k=1,GV%ke ; do i=segment%HI%isd,segment%HI%ied tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) enddo ; enddo elseif (segment%direction == OBC_DIRECTION_S) then J=segment%HI%JsdB - do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied + do k=1,GV%ke ; do i=segment%HI%isd,segment%HI%ied tv%T(i,j,k) = tv%T(i,j+1,k) ; tv%S(i,j,k) = tv%S(i,j+1,k) enddo ; enddo endif @@ -3641,18 +3647,19 @@ end subroutine deallocate_OBC_segment_data !> Set tangential velocities outside of open boundaries to silly values !! (used for checking the interior state is independent of values outside !! of the domain). -subroutine open_boundary_test_extern_uv(G, OBC, u, v) +subroutine open_boundary_test_extern_uv(G, GV, OBC, u, v) 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 structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)),intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G), SZK_(G)),intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)),intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)),intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] ! Local variables integer :: i, j, k, n if (.not. associated(OBC)) return do n = 1, OBC%number_of_segments - do k = 1, G%ke + do k = 1, GV%ke if (OBC%segment(n)%is_N_or_S) then J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then @@ -3763,7 +3770,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - nz=G%ke + nz=GV%ke turns = G%HI%turns @@ -3803,7 +3810,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do j=segment%HI%jsd,segment%HI%jed segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 - do k=1,G%ke + do k=1,GV%ke segment%h(I,j,k) = h(i+ishift,j,k) segment%Htot(I,j)=segment%Htot(I,j)+segment%h(I,j,k) enddo @@ -3816,14 +3823,14 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do i=segment%HI%isd,segment%HI%ied segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 - do k=1,G%ke + do k=1,GV%ke segment%h(i,J,k) = h(i,j+jshift,k) segment%Htot(i,J)=segment%Htot(i,J)+segment%h(i,J,k) enddo enddo endif - allocate(h_stack(G%ke)) + allocate(h_stack(GV%ke)) h_stack(:) = 0.0 do m = 1,segment%num_fields if (segment%field(m)%fid > 0) then @@ -3835,25 +3842,25 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (segment%field(m)%nk_src > 1) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) elseif (segment%field(m)%name == 'Vamp' .or. segment%field(m)%name == 'Vphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,siz(3))) ! 3rd dim is constituent elseif (segment%field(m)%name == 'Uamp' .or. segment%field(m)%name == 'Uphase' .or. & segment%field(m)%name == 'SSHamp' .or. segment%field(m)%name == 'SSHphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,siz(3))) ! 3rd dim is constituent else - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,GV%ke)) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) elseif (segment%field(m)%name == 'Uamp' .or. segment%field(m)%name == 'Uphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,siz(3))) ! 3rd dim is constituent elseif (segment%field(m)%name == 'Vamp' .or. segment%field(m)%name == 'Vphase' .or. & segment%field(m)%name == 'SSHamp' .or. segment%field(m)%name == 'SSHphase') then allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,siz(3))) ! 3rd dim is constituent else - allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,GV%ke)) endif endif else @@ -4038,19 +4045,19 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) elseif (G%mask2dCu(I,j)>0.) then h_stack(:) = h(i+ishift,j,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) elseif (G%mask2dCu(I,j+1)>0.) then h_stack(:) = h(i+ishift,j+1,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,J,:), & - G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) endif enddo else @@ -4065,7 +4072,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,j,:), & - G%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:)) + GV%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:)) endif enddo endif @@ -4084,19 +4091,19 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) elseif (G%mask2dCv(i,J)>0.) then h_stack(:) = h(i,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) elseif (G%mask2dCv(i+1,J)>0.) then h_stack(:) = h(i+1,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) endif enddo else @@ -4111,7 +4118,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(i,J,:), & segment%field(m)%buffer_src(i,J,:), & - G%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:)) + GV%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:)) endif enddo endif @@ -4130,37 +4137,37 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (.not. associated(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,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) else if (segment%field(m)%name == 'Vamp' .or. segment%field(m)%name == 'Vphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) elseif (segment%field(m)%name == 'U') then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,GV%ke)) elseif (segment%field(m)%name == 'Uamp' .or. segment%field(m)%name == 'Uphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,1)) elseif (segment%field(m)%name == 'DVDX') then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) elseif (segment%field(m)%name == 'SSH' .or. segment%field(m)%name == 'SSHamp' & .or. segment%field(m)%name == 'SSHphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,GV%ke)) endif else if (segment%field(m)%name == 'U') then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) elseif (segment%field(m)%name == 'Uamp' .or. segment%field(m)%name == 'Uphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) elseif (segment%field(m)%name == 'V') then - allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,GV%ke)) elseif (segment%field(m)%name == 'Vamp' .or. segment%field(m)%name == 'Vphase') then allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,1)) elseif (segment%field(m)%name == 'DUDY') then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) elseif (segment%field(m)%name == 'SSH' .or. segment%field(m)%name == 'SSHamp' & .or. segment%field(m)%name == 'SSHphase') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else - allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,GV%ke)) endif endif segment%field(m)%buffer_dst(:,:,:) = segment%field(m)%value @@ -4185,7 +4192,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + (OBC%tide_eq_phases(c) + OBC%tide_un(c))) enddo endif - do k=1,G%ke + do k=1,GV%ke segment%normal_vel(I,j,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,j,k) + tidal_vel) segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k)*segment%h(I,j,k) * G%dyCu(I,j) normal_trans_bt(I,j) = normal_trans_bt(I,j) + segment%normal_trans(I,j,k) @@ -4206,7 +4213,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + (OBC%tide_eq_phases(c) + OBC%tide_un(c))) enddo endif - do k=1,G%ke + do k=1,GV%ke segment%normal_vel(i,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(i,J,k) + tidal_vel) segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k)*segment%h(i,J,k) * & G%dxCv(i,J) @@ -4228,7 +4235,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + (OBC%tide_eq_phases(c) + OBC%tide_un(c))) enddo endif - do k=1,G%ke + 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)) & @@ -4246,7 +4253,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + (OBC%tide_eq_phases(c) + OBC%tide_un(c))) enddo endif - do k=1,G%ke + 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)) & @@ -4257,7 +4264,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) associated(segment%tangential_grad)) then I=is_obc do J=js_obc,je_obc - do k=1,G%ke + 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)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) @@ -4267,7 +4274,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) associated(segment%tangential_grad)) then J=js_obc do I=is_obc,ie_obc - do k=1,G%ke + 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)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) @@ -4633,8 +4640,9 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments -subroutine fill_temp_salt_segments(G, OBC, tv) +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 @@ -4650,7 +4658,7 @@ subroutine fill_temp_salt_segments(G, OBC, tv) call pass_var(tv%T, G%Domain) call pass_var(tv%S, G%Domain) - nz = G%ke + nz = GV%ke do n=1, OBC%number_of_segments segment => OBC%segment(n) @@ -4689,7 +4697,7 @@ subroutine fill_temp_salt_segments(G, OBC, tv) segment%tr_Reg%Tr(2)%tres(:,:,:) = segment%tr_Reg%Tr(2)%t(:,:,:) enddo - call setup_OBC_tracer_reservoirs(G, OBC) + call setup_OBC_tracer_reservoirs(G, GV, OBC) end subroutine fill_temp_salt_segments !> Find the region outside of all open boundary segments and @@ -5476,7 +5484,7 @@ subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) enddo if (use_temperature) & - call fill_temp_salt_segments(G, OBC, tv) + call fill_temp_salt_segments(G, GV, OBC, tv) call open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) end subroutine rotate_OBC_init diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index ebd269c960..531944f361 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -8,6 +8,7 @@ module MOM_variables use MOM_debugging, only : hchksum use MOM_error_handler, only : MOM_error, FATAL use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type @@ -473,14 +474,15 @@ subroutine rotate_surface_state(sfc_state_in, G_in, sfc_state, G, turns) end subroutine rotate_surface_state !> Allocates the arrays contained within a BT_cont_type and initializes them to 0. -subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) - type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be allocated - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - logical, optional, intent(in) :: alloc_faces !< If present and true, allocate +subroutine alloc_BT_cont_type(BT_cont, G, GV, alloc_faces) + type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be allocated + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, optional, intent(in) :: alloc_faces !< If present and true, allocate !! memory for effective face thicknesses. - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + 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(BT_cont)) call MOM_error(FATAL, & @@ -502,8 +504,8 @@ subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) allocate(BT_cont%vBT_NN(isd:ied,JsdB:JedB)) ; BT_cont%vBT_NN(:,:) = 0.0 if (present(alloc_faces)) then ; if (alloc_faces) then - allocate(BT_cont%h_u(IsdB:IedB,jsd:jed,1:G%ke)) ; BT_cont%h_u(:,:,:) = 0.0 - allocate(BT_cont%h_v(isd:ied,JsdB:JedB,1:G%ke)) ; BT_cont%h_v(:,:,:) = 0.0 + allocate(BT_cont%h_u(IsdB:IedB,jsd:jed,1:nz)) ; BT_cont%h_u(:,:,:) = 0.0 + allocate(BT_cont%h_v(isd:ied,JsdB:JedB,1:nz)) ; BT_cont%h_v(:,:,:) = 0.0 endif ; endif end subroutine alloc_BT_cont_type diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index f6326b06fa..aeee768272 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -110,7 +110,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp h_scale = GV%H_to_m ; uh_scale = GV%H_to_m*US%L_T_to_m_s ! if (.not.associated(CS)) return - nz = G%ke + nz = GV%ke if (CS%cols_written < CS%max_writes) then CS%cols_written = CS%cols_written + 1 @@ -443,7 +443,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp h_scale = GV%H_to_m ; uh_scale = GV%H_to_m*US%L_T_to_m_s ! if (.not.associated(CS)) return - nz = G%ke + nz = GV%ke if (CS%cols_written < CS%max_writes) then CS%cols_written = CS%cols_written + 1 diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1f55801064..f1c3a0c777 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -257,7 +257,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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 = G%ke ; nkmb = GV%nk_rho_varies + nz = GV%ke ; nkmb = GV%nk_rho_varies ! This value is roughly (pi / (the age of the universe) )^2. absurdly_small_freq2 = 1e-34*US%T_to_s**2 @@ -860,7 +860,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) real :: IG_Earth ! Inverse of gravitational acceleration [T2 Z L-2 ~> s2 m-1]. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (CS%id_mass_wt > 0) then do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo @@ -975,7 +975,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS real :: KE_h(SZI_(G),SZJ_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 do j=js-1,je ; do i=is-1,ie @@ -1431,7 +1431,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy real :: H_to_RZ_dt ! A conversion factor from accumulated transports to fluxes ! [R Z H-1 T-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Idt = 1. / dt_trans H_to_RZ_dt = GV%H_to_RZ * Idt @@ -1526,7 +1526,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 @@ -1866,7 +1866,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag long_name='Sea Water Pressure at Sea Floor', standard_name='sea_water_pressure_at_sea_floor', & units='Pa', conversion=US%RL2_T2_to_Pa) - call set_dependent_diagnostics(MIS, ADp, CDp, G, CS) + call set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) end subroutine MOM_diagnostics_init @@ -2174,7 +2174,7 @@ end subroutine write_static_fields !> This subroutine sets up diagnostics upon which other diagnostics depend. -subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) +subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to !! the fields and accelerations making up ocean !! internal physical state. @@ -2183,12 +2183,13 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) type(cont_diag_ptrs), intent(inout) :: CDp !< Structure pointing to terms in continuity !! 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 !! module. ! This subroutine sets up diagnostics upon which other diagnostics depend. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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. & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 1742ec1247..ab0e0e1af1 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -131,19 +131,20 @@ module MOM_sum_output contains !> MOM_sum_output_init initializes the parameters and settings for the MOM_sum_output module. -subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & +subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & Input_start_time, 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 - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time - !! parameters. - character(len=*), intent(in) :: directory !< The directory where the energy file goes. - integer, target, intent(inout) :: ntrnc !< The integer that stores the number of times - !! the velocity has been truncated since the - !! last call to write_energy. - type(time_type), intent(in) :: Input_start_time !< The start time of the simulation. - type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + character(len=*), intent(in) :: directory !< The directory where the energy file goes. + integer, target, intent(inout) :: ntrnc !< The integer that stores the number of times + !! the velocity has been truncated since the + !! last call to write_energy. + type(time_type), intent(in) :: Input_start_time !< The start time of the simulation. + type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. ! Local variables real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS. real :: Rho_0 ! A reference density [kg m-3] @@ -248,8 +249,8 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & default=.false.) endif - allocate(CS%lH(G%ke)) - call depth_list_setup(G, US, CS) + allocate(CS%lH(GV%ke)) + call depth_list_setup(G, GV, US, CS) else CS%list_size = 0 endif @@ -481,7 +482,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ local_open_BC = (OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) endif ; endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 isr = is - (G%isd-1) ; ier = ie - (G%isd-1) ; jsr = js - (G%jsd-1) ; jer = je - (G%jsd-1) @@ -1089,11 +1090,12 @@ end subroutine accumulate_net_input !! cross sectional areas at each depth and the volume of fluid deeper !! than each depth. This might be read from a previously created file !! or it might be created anew. (For now only new creation occurs. -subroutine depth_list_setup(G, US, 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 - type(Sum_output_CS), pointer :: CS !< The control structure returned by a - !! previous call to MOM_sum_output_init. +subroutine depth_list_setup(G, GV, US, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(Sum_output_CS), pointer :: CS !< The control structure returned by a + !! previous call to MOM_sum_output_init. ! Local variables integer :: k @@ -1111,7 +1113,7 @@ subroutine depth_list_setup(G, US, CS) call create_depth_list(G, CS) endif - do k=1,G%ke + do k=1,GV%ke CS%lH(k) = CS%list_size enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 8b50fe1acb..86482b9a03 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -151,7 +151,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: l_mono_N2_column_fraction, l_mono_N2_depth real :: mode_struct(SZK_(G)), ms_min, ms_max, ms_sq - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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.") @@ -736,7 +736,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee integer :: sub, sub_it integer :: i, j, k, k2, itt, is, ie, js, je, nz, row, iint, m, ig, jg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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: "// & diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 88b062472f..c3a5b6ef46 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -180,7 +180,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo integer :: kc integer :: i, j, k, k2, itt, is, ie, js, je, nz, nzm, row, ig, jg, ig_stop, jg_stop - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 @@ -683,9 +683,10 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) end subroutine tridiag_solver !> Allocate memory associated with the wave structure module and read parameters. -subroutine wave_structure_init(Time, G, param_file, diag, CS) +subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -697,7 +698,7 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS) character(len=40) :: mdl = "MOM_wave_structure" ! This module's name. integer :: isd, ied, jsd, jed, nz - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 "// & diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 28c4c867d7..55bde07b42 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -583,7 +583,7 @@ subroutine set_axes_info(G, GV, US, param_file, diag_cs, set_vertical) !Define the downsampled axes call set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) - call diag_grid_storage_init(diag_CS%diag_grid_temp, G, diag_CS) + call diag_grid_storage_init(diag_CS%diag_grid_temp, G, GV, diag_CS) end subroutine set_axes_info @@ -3584,9 +3584,10 @@ subroutine log_chksum_diag(docunit, description, chksum) end subroutine log_chksum_diag !> Allocates fields necessary to store diagnostic remapping fields -subroutine diag_grid_storage_init(grid_storage, G, diag) +subroutine diag_grid_storage_init(grid_storage, G, GV, diag) type(diag_grid_storage), intent(inout) :: grid_storage !< Structure containing a snapshot of the target grids type(ocean_grid_type), intent(in) :: G !< Horizontal grid + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(diag_ctrl), intent(in) :: diag !< Diagnostic control structure used as the contructor !! template for this routine @@ -3597,7 +3598,7 @@ subroutine diag_grid_storage_init(grid_storage, G, diag) if (grid_storage%num_diag_coords < 1) return ! Allocate memory for the native space - allocate(grid_storage%h_state(G%isd:G%ied,G%jsd:G%jed, G%ke)) + allocate( grid_storage%h_state(G%isd:G%ied, G%jsd:G%jed, GV%ke)) ! Allocate diagnostic remapping structures allocate(grid_storage%diag_grids(diag%num_diag_coords)) ! Loop through and allocate memory for the grid on each target coordinate diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 4e12abaa5b..08d60b20e4 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -327,7 +327,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then - call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & + call build_rho_column(get_rho_CS(remap_cs%regrid_cs), GV%ke, & GV%Z_to_H*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7972b51fe4..38788411b8 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -177,7 +177,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -267,55 +267,55 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", & default="uniform", do_not_log=just_read) select case (trim(config)) - case ("file") - call initialize_thickness_from_file(h, G, GV, US, PF, .false., just_read_params=just_read) - case ("thickness_file") - call initialize_thickness_from_file(h, G, GV, US, PF, .true., just_read_params=just_read) - case ("coord") - if (new_sim .and. useALE) then - call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) - elseif (new_sim) then - call MOM_error(FATAL, "MOM_initialize_state: USE_REGRIDDING must be True "//& - "for THICKNESS_CONFIG of 'coord'") - endif - case ("uniform"); call initialize_thickness_uniform(h, G, GV, PF, & - just_read_params=just_read) - case ("list"); call initialize_thickness_list(h, G, GV, US, PF, & - just_read_params=just_read) - case ("DOME"); call DOME_initialize_thickness(h, G, GV, PF, & - just_read_params=just_read) - case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, US, PF, tv, & + case ("file") + call initialize_thickness_from_file(h, G, GV, US, PF, .false., just_read_params=just_read) + case ("thickness_file") + call initialize_thickness_from_file(h, G, GV, US, PF, .true., just_read_params=just_read) + case ("coord") + if (new_sim .and. useALE) then + call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) + elseif (new_sim) then + call MOM_error(FATAL, "MOM_initialize_state: USE_REGRIDDING must be True "//& + "for THICKNESS_CONFIG of 'coord'") + endif + case ("uniform"); call initialize_thickness_uniform(h, G, GV, PF, & just_read_params=just_read) - case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) - case ("Neverwoorld","Neverland"); call Neverworld_initialize_thickness(h, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref) - case ("search"); call initialize_thickness_search - case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & - just_read_params=just_read) - case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) - case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) - case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, US, PF, & + case ("list"); call initialize_thickness_list(h, G, GV, US, PF, & just_read_params=just_read) - case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) - case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, US, PF, & - just_read_params=just_read) - case ("seamount"); call seamount_initialize_thickness(h, G, GV, US, PF, & - just_read_params=just_read) - case ("dumbbell"); call dumbbell_initialize_thickness(h, G, GV, US, PF, & - just_read_params=just_read) - case ("soliton"); call soliton_initialize_thickness(h, G, GV, US) - case ("phillips"); call Phillips_initialize_thickness(h, G, GV, US, PF, & - just_read_params=just_read) - case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & + case ("DOME"); call DOME_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, US, PF, tv, & + just_read_params=just_read) + case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, US, PF, & + tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) + case ("Neverwoorld","Neverland"); call Neverworld_initialize_thickness(h, G, GV, US, PF, & + tv%eqn_of_state, tv%P_Ref) + case ("search"); call initialize_thickness_search + case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) - case ("USER"); call user_initialize_thickness(h, G, GV, PF, & - just_read_params=just_read) - case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& - "Unrecognized layer thickness configuration "//trim(config)) + case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & + PF, just_read_params=just_read) + case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, US, PF, & + just_read_params=just_read) + case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & + PF, just_read_params=just_read) + case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, US, PF, & + just_read_params=just_read) + case ("seamount"); call seamount_initialize_thickness(h, G, GV, US, PF, & + just_read_params=just_read) + case ("dumbbell"); call dumbbell_initialize_thickness(h, G, GV, US, PF, & + just_read_params=just_read) + case ("soliton"); call soliton_initialize_thickness(h, G, GV, US) + case ("phillips"); call Phillips_initialize_thickness(h, G, GV, US, PF, & + just_read_params=just_read) + case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & + PF, just_read_params=just_read) + case ("USER"); call user_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& + "Unrecognized layer thickness configuration "//trim(config)) end select ! Initialize temperature and salinity (T and S). @@ -345,13 +345,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & select case (trim(config)) case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, & eos, tv%P_Ref, just_read_params=just_read) - case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, & + case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, GV, & PF, just_read_params=just_read) case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & G, GV, US, PF, eos, tv%P_Ref, just_read_params=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & - G, PF, just_read_params=just_read) - case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, PF, & + G, GV, PF, just_read_params=just_read) + case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, PF, & just_read_params=just_read) case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) @@ -373,7 +373,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & G, GV, US, PF, just_read_params=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & h, just_read_params=just_read) - case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, PF, eos, & + case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, eos, & just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized Temp & salt configuration "//trim(config)) @@ -381,7 +381,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & endif endif ! not from_Z_file. if (use_temperature .and. use_OBC) & - call fill_temp_salt_segments(G, OBC, tv) + call fill_temp_salt_segments(G, GV, OBC, tv) ! The thicknesses in halo points might be needed to initialize the velocities. if (new_sim) call pass_var(h, G%Domain) @@ -400,20 +400,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, US, PF, & + case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, & just_read_params=just_read) - case ("zero"); call initialize_velocity_zero(u, v, G, PF, & + case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, & just_read_params=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, US, PF, & + case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, & just_read_params=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, US, PF, & + case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, & just_read_params=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read_params=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G, US) - case ("USER"); call user_initialize_velocity(u, v, G, US, PF, & + case ("soliton"); call soliton_initialize_velocity(u, v, h, G, GV, US) + case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) @@ -586,17 +586,17 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & elseif (trim(config) == "shelfwave") then OBC%update_OBC = .true. elseif (lowercase(trim(config)) == "supercritical") then - call supercritical_set_OBC_data(OBC, G, PF) + call supercritical_set_OBC_data(OBC, G, GV, PF) elseif (trim(config) == "tidal_bay") then OBC%update_OBC = .true. elseif (trim(config) == "USER") then - call user_set_OBC_data(OBC, tv, G, PF, tracer_Reg) + call user_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) elseif (.not. trim(config) == "none") then call MOM_error(FATAL, "The open boundary conditions specified by "//& "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, PF, tracer_Reg) + call set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) endif endif ! if (open_boundary_query(OBC, apply_nudged_OBC=.true.)) then @@ -640,7 +640,7 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -721,7 +721,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) real :: hTmp, eTmp, dilate character(len=100) :: mesg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke hTolerance = 0.1*US%m_to_Z contractions = 0 @@ -801,7 +801,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -859,7 +859,7 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) character(len=72) :: eta_var integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -941,7 +941,7 @@ subroutine convert_thickness(h, G, GV, US, tv) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: itt, max_itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 @@ -1017,7 +1017,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) character(len=200) :: filename, eta_srf_var ! Strings for file/path logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1150,7 +1150,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, .true.) else ! call MOM_error(FATAL, "trim_for_ice: Does not work without ALE mode") - do k=1,G%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec T_t(i,j,k) = tv%T(i,j,k) ; T_b(i,j,k) = tv%T(i,j,k) S_t(i,j,k) = tv%S(i,j,k) ; S_b(i,j,k) = tv%S(i,j,k) enddo ; enddo ; enddo @@ -1268,8 +1268,9 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, end subroutine cut_off_column_top !> Initialize horizontal velocity components from file -subroutine initialize_velocity_from_file(u, v, G, US, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read_params) 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1309,8 +1310,9 @@ subroutine initialize_velocity_from_file(u, v, G, US, param_file, just_read_para end subroutine initialize_velocity_from_file !> Initialize horizontal velocity components to zero. -subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1323,7 +1325,7 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) character(len=200) :: mdl = "initialize_velocity_zero" ! This subroutine's name. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1343,8 +1345,9 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, US, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read_params) 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1359,7 +1362,7 @@ subroutine initialize_velocity_uniform(u, v, G, US, param_file, just_read_params real :: initial_u_const, initial_v_const logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: mdl = "initialize_velocity_uniform" ! This subroutine's name. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1384,8 +1387,9 @@ end subroutine initialize_velocity_uniform !> Sets the initial velocity components to be circular with !! no flow at edges of domain and center. -subroutine initialize_velocity_circular(u, v, G, US, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read_params) 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1402,7 +1406,7 @@ subroutine initialize_velocity_circular(u, v, G, US, param_file, just_read_param real :: psi1, psi2 ! Values of the streamfunction at two points [L2 T-1 ~> m2 s-1] logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1447,8 +1451,9 @@ end function my_psi end subroutine initialize_velocity_circular !> Initializes temperature and salinity from file -subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read_params) + 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_(G)), intent(out) :: T !< The potential temperature that is !! being initialized [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is @@ -1503,8 +1508,9 @@ subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) end subroutine initialize_temp_salt_from_file !> Initializes temperature and salinity from a 1D profile -subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params) +subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_params) 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_(G)), intent(out) :: T !< The potential temperature that is !! being initialized [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is @@ -1540,7 +1546,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para call MOM_read_data(filename, "PTEMP", T0(:)) call MOM_read_data(filename, "SALT", S0(:)) - do k=1,G%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) enddo ; enddo ; enddo @@ -1576,7 +1582,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_fit" ! This subroutine's name. integer :: i, j, k, itt, nz - nz = G%ke + nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1642,8 +1648,9 @@ end subroutine initialize_temp_salt_fit !! !! \remark Note that the linear distribution is set up with respect to the layer !! number, not the physical position). -subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read_params) + 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_(G)), intent(out) :: T !< The potential temperature that is !! being initialized [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is @@ -1682,24 +1689,24 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. ! Prescribe salinity -! delta_S = S_range / ( G%ke - 1.0 ) +! delta_S = S_range / ( GV%ke - 1.0 ) ! S(:,:,1) = S_top -! do k = 2,G%ke +! do k=2,GV%ke ! S(:,:,k) = S(:,:,k-1) + delta_S ! enddo - do k = 1,G%ke - S(:,:,k) = S_top - S_range*((real(k)-0.5)/real(G%ke)) - T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(G%ke)) + do k=1,GV%ke + S(:,:,k) = S_top - S_range*((real(k)-0.5)/real(GV%ke)) + T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(GV%ke)) enddo ! Prescribe temperature -! delta_T = T_range / ( G%ke - 1.0 ) +! delta_T = T_range / ( GV%ke - 1.0 ) ! T(:,:,1) = T_top -! do k = 2,G%ke +! do k=2,GV%ke ! T(:,:,k) = T(:,:,k-1) + delta_T ! enddo ! delta = 1 -! T(:,:,G%ke/2 - (delta-1):G%ke/2 + delta) = 1.0 +! T(:,:,GV%ke/2 - (delta-1):GV%ke/2 + delta) = 1.0 call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_linear @@ -1752,7 +1759,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L ! time prior to vertical remapping. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed pres(:) = 0.0 ; tmp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 @@ -1882,7 +1889,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L do k=1,nz; do j=js,je ; do i=is,ie h(i,j,k) = GV%Z_to_H*(eta(i,j,k)-eta(i,j,k+1)) enddo ; enddo ; enddo - call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp, h, nz_data) + call initialize_ALE_sponge(Idamp, G, GV, param_file, ALE_CSp, h, nz_data) deallocate(eta) deallocate(h) if (use_temperature) then @@ -1895,7 +1902,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L endif else ! Initialize sponges without supplying sponge grid - call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp) + call initialize_ALE_sponge(Idamp, G, GV, param_file, ALE_CSp) ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature) then call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp) @@ -2066,7 +2073,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param call cpu_clock_begin(id_clock_routine) - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg @@ -2364,7 +2371,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param nkml = 0 ; if (separate_mixed_layer) nkml = GV%nkml - call find_interfaces(rho_z, z_in, kd, Rb, G%bathyT, zi, G, US, & + call find_interfaces(rho_z, z_in, kd, Rb, G%bathyT, zi, G, GV, US, & nlevs, nkml, hml=Hmix_depth, eps_z=eps_z, eps_rho=eps_rho) if (correct_thickness) then @@ -2432,7 +2439,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Finally adjust to target density ks = 1 ; if (separate_mixed_layer) ks = GV%nk_rho_varies + 1 call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), tv%P_Ref, niter, & - missing_value, h, ks, G, US, eos) + missing_value, h, ks, G, GV, US, eos) endif deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) @@ -2449,9 +2456,10 @@ end subroutine MOM_temp_salt_initialize_from_Z !> Find interface positions corresponding to interpolated depths in a density profile -subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, US, nlevs, nkml, hml, & +subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, GV, US, nlevs, nkml, hml, & eps_z, eps_rho) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: nk_data !< The number of levels in the input data real, dimension(SZI_(G),SZJ_(G),nk_data), & intent(in) :: rho !< Potential density in z-space [R ~> kg m-3] @@ -2482,7 +2490,7 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, US, nlevs, nkml, integer :: k_int, lo_int, hi_int, mid integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke zi(:,:,:) = 0.0 diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 1a4c5bd011..c349ab30b1 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -4,27 +4,17 @@ module MOM_tracer_initialization_from_Z ! This file is part of MOM6. See LICENSE.md for the license. use MOM_debugging, only : hchksum -use MOM_coms, only : max_across_PEs, min_across_PEs use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_ROUTINE, CLOCK_LOOP -use MOM_density_integrals, only : int_specific_vol_dp -use MOM_domains, only : pass_var, pass_vector, sum_across_PEs, broadcast -use MOM_domains, only : root_PE, To_All, SCALAR_PAIR, CGRID_NE, AGRID -use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe +use MOM_cpu_clock, only : CLOCK_ROUTINE, CLOCK_LOOP +use MOM_domains, only : pass_var +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_file_parser, only : get_param, read_param, log_param, param_file_type -use MOM_file_parser, only : log_version -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type, isPointInCell +use MOM_file_parser, only : get_param, param_file_type, log_version +use MOM_grid, only : ocean_grid_type use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer -use MOM_regridding, only : regridding_CS use MOM_remapping, only : remapping_CS, initialize_remapping -use MOM_remapping, only : remapping_core_h -use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type, setVerticalGridAxes -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type +use MOM_verticalGrid, only : verticalGrid_type use MOM_ALE, only : ALE_remap_scalar implicit none ; private @@ -42,7 +32,7 @@ module MOM_tracer_initialization_from_Z contains -!> Initializes a tracer from a z-space data file. +!> Initializes a tracer from a z-space data file, including any lateral regridding that is needed. subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_nam, & src_var_unit_conversion, src_var_record, homogenize, & useALEremapping, remappingScheme, src_var_gridspec ) @@ -98,7 +88,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ call cpu_clock_begin(id_clock_routine) - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 3f7f2ee548..ae84858234 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -167,7 +167,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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, & diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3c63564a30..65d2c34d06 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -372,7 +372,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n real :: inv_PI3, inv_PI2, inv_PI6 - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB h_neglect = GV%H_subroundoff @@ -1127,7 +1127,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo if (CS%use_GME) then - call thickness_diffuse_get_KH(TD, KH_u_GME, KH_v_GME, G) + call thickness_diffuse_get_KH(TD, KH_u_GME, KH_v_GME, G, GV) call pass_vector(KH_u_GME, KH_v_GME, G%Domain) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1414,9 +1414,10 @@ 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, US, param_file, diag, CS, MEKE, ADp) +subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, 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 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. @@ -1479,7 +1480,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE, ADp) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_hor_visc" ! module name - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -2083,30 +2084,30 @@ subroutine hor_visc_init(Time, G, 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,G%ke) - ! call safe_alloc_ptr(ADp%diag_hfrac_u,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) + ! call safe_alloc_ptr(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 !CS%id_hf_diffv = register_diag_field('ocean_model', 'hf_diffv', diag%axesCvL, Time, & ! '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,G%ke) - ! call safe_alloc_ptr(ADp%diag_hfrac_v,G%isd,G%ied,G%JsdB,G%JedB,G%ke) + ! call safe_alloc_ptr(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 CS%id_hf_diffu_2d = register_diag_field('ocean_model', 'hf_diffu_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Horizontal Viscosity', 'm s-2', & conversion=US%L_T2_to_m_s2) if ((CS%id_hf_diffu_2d > 0) .and. (present(ADp))) then - call safe_alloc_ptr(ADp%diag_hfrac_u,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) + call safe_alloc_ptr(ADp%diag_hfrac_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_hf_diffv_2d = register_diag_field('ocean_model', 'hf_diffv_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Horizontal Viscosity', 'm s-2', & conversion=US%L_T2_to_m_s2) if ((CS%id_hf_diffv_2d > 0) .and. (present(ADp))) then - call safe_alloc_ptr(ADp%diag_hfrac_v,G%isd,G%ied,G%JsdB,G%JedB,G%ke) + call safe_alloc_ptr(ADp%diag_hfrac_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif if (CS%biharmonic) then diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 2bb3c3b0f1..37116fcae6 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -2540,7 +2540,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, param_file, diag, CS%wave_structure_CSp) + call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_structure_CSp) end subroutine internal_tides_init diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index c8406e8677..d0f81853e3 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -205,7 +205,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) integer :: power_2 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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:"// & @@ -514,7 +514,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS, O if (.not. associated(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 = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke local_open_u_BC = .false. local_open_v_BC = .false. @@ -679,7 +679,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (.not. associated(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 = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke local_open_u_BC = .false. local_open_v_BC = .false. @@ -842,7 +842,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo 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 = G%ke + nz = GV%ke inv_PI3 = 1.0/((4.0*atan(1.0))**3) @@ -1059,7 +1059,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "The depth below which N2 is monotonized to avoid stratification "//& "artifacts from altering the equivalent barotropic mode structure.",& units="m", default=2000., scale=US%m_to_Z) - allocate(CS%ebt_struct(isd:ied,jsd:jed,G%ke)) ; CS%ebt_struct(:,:,:) = 0.0 + allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke)) ; CS%ebt_struct(:,:,:) = 0.0 endif if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) then @@ -1073,8 +1073,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%use_stored_slopes) then in_use = .true. - allocate(CS%slope_x(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%slope_x(:,:,:) = 0.0 - allocate(CS%slope_y(isd:ied,JsdB:JedB,G%ke+1)) ; CS%slope_y(:,:,:) = 0.0 + allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1)) ; CS%slope_x(:,:,:) = 0.0 + allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1)) ; CS%slope_y(:,:,:) = 0.0 call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & @@ -1313,8 +1313,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ALLOC_(CS%Laplac3_const_u(IsdB:IedB,jsd:jed)) ; CS%Laplac3_const_u(:,:) = 0.0 ALLOC_(CS%Laplac3_const_v(isd:ied,JsdB:JedB)) ; CS%Laplac3_const_v(:,:) = 0.0 - ALLOC_(CS%KH_u_QG(IsdB:IedB,jsd:jed,G%ke)) ; CS%KH_u_QG(:,:,:) = 0.0 - ALLOC_(CS%KH_v_QG(isd:ied,JsdB:JedB,G%ke)) ; CS%KH_v_QG(:,:,:) = 0.0 + ALLOC_(CS%KH_u_QG(IsdB:IedB,jsd:jed,GV%ke)) ; CS%KH_u_QG(:,:,:) = 0.0 + ALLOC_(CS%KH_v_QG(isd:ied,JsdB:JedB,GV%ke)) ; CS%KH_v_QG(:,:,:) = 0.0 ! register diagnostics CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 37bbaa4230..1d28d58b55 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -194,7 +194,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var DD(z) = (1.-3.*(XP(z)**2)+2.*(XP(z)**3))**(1.+2.*CS%MLE_tail_dh) PSI(z) = max( PSI1(z), DD(z)*BOTTOP(z) ) ! Combines original PSI1 with tail - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & @@ -611,7 +611,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkml - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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: "// & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 6ff0184d54..c83df84d4b 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -165,7 +165,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if ((.not.CS%thickness_diffuse) .or. & .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff if (associated(MEKE)) then @@ -693,7 +693,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV logical :: use_Stanley integer :: is, ie, js, je, nz, IsdB, halo integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ; IsdB = G%IsdB I4dt = 0.25 / dt I_slope_max2 = 1.0 / (CS%slope_max**2) @@ -1567,7 +1567,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV logical, dimension(SZIB_(G)) :: & do_i ! If true, work on a column. integer :: i, j, k, n, ish, jsh, is, ie, js, je, nz, k_top - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke k_top = GV%nk_rho_varies + 1 h_neglect = GV%H_subroundoff @@ -2019,20 +2019,20 @@ 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,G%ke+1) - call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) + 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) endif CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & 'Time Mean Diffusive Zonal Thickness Flux', & 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & y_cell_method='sum', v_extensive=.true.) - if (CS%id_uhGM > 0) call safe_alloc_ptr(CDp%uhGM,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) + if (CS%id_uhGM > 0) call safe_alloc_ptr(CDp%uhGM,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) CS%id_vhGM = register_diag_field('ocean_model', 'vhGM', diag%axesCvL, Time, & 'Time Mean Diffusive Meridional Thickness Flux', & 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & x_cell_method='sum', v_extensive=.true.) - if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,G%ke) + if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & 'Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection', & @@ -2067,10 +2067,10 @@ 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') - if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,G%ke+1) + if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) CS%id_slope_y = register_diag_field('ocean_model', 'neutral_slope_y', diag%axesCvi, Time, & 'Meridional slope of neutral surface', 'nondim') - if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) + if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) 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) @@ -2087,10 +2087,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) end subroutine thickness_diffuse_init !> Copies ubtav and vbtav from private type into arrays -subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) - type(thickness_diffuse_CS), pointer :: CS !< Control structure for - !! this module +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(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME !< interface height !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME !< interface height @@ -2098,11 +2098,11 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) ! Local variables integer :: i,j,k - do k=1,G%ke+1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec + do k=1,GV%ke+1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec KH_u_GME(I,j,k) = CS%KH_u_GME(I,j,k) enddo ; enddo ; enddo - do k=1,G%ke+1 ; do J = G%jsc-1, G%jec ; do i = G%isc, G%iec + do k=1,GV%ke+1 ; do J = G%jsc-1, G%jec ; do i = G%isc, G%iec KH_v_GME(i,J,k) = CS%KH_v_GME(i,J,k) enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 7ef0877321..09cd050a4a 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -145,9 +145,9 @@ module MOM_ALE_sponge !> This subroutine determines the number of points which are within sponges in this computational !! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. It also stores the target interface heights. -subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. +subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, nz_data) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. integer, intent(in) :: nz_data !< The total number of sponge input layers. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time [T-1 ~> s-1]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -213,7 +213,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ "forms of the same expressions.", default=default_2018_answers) CS%time_varying_sponges = .false. - CS%nz = G%ke + CS%nz = GV%ke CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed CS%iscB = G%iscB ; CS%iecB = G%iecB; CS%jscB = G%jscB ; CS%jecB = G%jecB @@ -389,8 +389,8 @@ end subroutine get_ALE_sponge_thicknesses !> This subroutine determines the number of points which are to be restoref in the computational !! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. -subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) - +subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS) + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time [T-1 ~> s-1]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse @@ -448,7 +448,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) "assumed to be on the model grid " , & default=.false.) CS%time_varying_sponges = .true. - CS%nz = G%ke + CS%nz = GV%ke CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed CS%iscB = G%iscB ; CS%iecB = G%iecB; CS%jscB = G%jscB ; CS%jecB = G%jecB @@ -810,7 +810,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real :: zTopOfCell, zBottomOfCell ! Heights [Z ~> m]. integer :: nPoints - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return if (.not.CS%remap_answers_2018) then @@ -986,16 +986,17 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) end subroutine apply_ALE_sponge !> Rotate the ALE sponge fields from the input to the model index map. -subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, turns, param_file) - type(ALE_sponge_CS), intent(in) :: sponge_in !< The control structure for this module with the - !! original grid rotation - type(ocean_grid_type), intent(in) :: G_in !< The ocean's grid structure with the original rotation. - type(ALE_sponge_CS), pointer :: sponge !< A pointer to the control that will be set up with - !! the new grid rotation - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure with the new rotation. - integer, intent(in) :: turns !< The number of 90-degree turns between grids - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. +subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) + type(ALE_sponge_CS), intent(in) :: sponge_in !< The control structure for this module with the + !! original grid rotation + type(ocean_grid_type), intent(in) :: G_in !< The ocean's grid structure with the original rotation. + type(ALE_sponge_CS), pointer :: sponge !< A pointer to the control that will be set up with + !! the new grid rotation + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure with the new rotation. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + integer, intent(in) :: turns !< The number of 90-degree turns between grids + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. ! First part: Index construction ! 1. Reconstruct Iresttime(:,:) from sponge_in @@ -1041,10 +1042,10 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, turns, param_file) call rotate_array(Iresttime_in, turns, Iresttime) if (fixed_sponge) then call rotate_array(data_h_in, turns, data_h) - call initialize_ALE_sponge_fixed(Iresttime, G, param_file, sponge, & + call initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, sponge, & data_h, nz_data) else - call initialize_ALE_sponge_varying(Iresttime, G, param_file, sponge) + call initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, sponge) endif deallocate(Iresttime_in) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index ae650664b6..bfd0f77b38 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -625,11 +625,11 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! Local variables integer :: i, j, k ! Loop indices - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) - real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces [m2 s-1] - real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces [m2 s-1] - real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces [m2 s-1] + real, dimension( GV%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces [m2 s-1] + real, dimension( GV%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] real :: surfFricVel, surfBuoyFlux real :: sigma, sigmaRatio @@ -674,7 +674,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. - do k=1,G%ke + do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment @@ -714,12 +714,12 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kviscosity(:) = US%Z2_T_to_m2_s * Kv(i,j,:) endif - call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] + call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] Kdiffusivity(:,1), & ! (inout) Total heat diffusivity [m2 s-1] Kdiffusivity(:,2), & ! (inout) Total salt diffusivity [m2 s-1] iFaceHeight, & ! (in) Height of interfaces [m] cellHeight, & ! (in) Height of level centers [m] - Kviscosity(:), & ! (in) Original viscosity [m2 s-1] + Kviscosity(:), & ! (in) Original viscosity [m2 s-1] Kdiffusivity(:,1), & ! (in) Original heat diffusivity [m2 s-1] Kdiffusivity(:,2), & ! (in) Original salt diffusivity [m2 s-1] CS%OBLdepth(i,j), & ! (in) OBL depth [m] @@ -728,12 +728,12 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & nonLocalTrans(:,2),& ! (out) Non-local salt transport [nondim] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] - G%ke, & ! (in) Number of levels to compute coeffs for - G%ke, & ! (in) Number of levels in array shape + GV%ke, & ! (in) Number of levels to compute coeffs for + GV%ke, & ! (in) Number of levels in array shape CVMix_kpp_params_user=CS%KPP_params ) ! safety check, Kviscosity and Kdiffusivity must be >= 0 - do k=1, G%ke+1 + do k=1, GV%ke+1 if (Kviscosity(k) < 0. .or. Kdiffusivity(k,1) < 0.) then call MOM_error(FATAL,"KPP_calculate, after CVMix_coeffs_kpp: "// & "Negative vertical viscosity or diffusivity has been detected. " // & @@ -757,7 +757,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !call MOM_error(WARNING,"Unexpected behavior in MOM_CVMix_KPP, see error in LT_K_ENHANCEMENT") LangEnhK = 1.0 endif - do k=1,G%ke + do k=1,GV%ke if (CS%LT_K_SHAPE== LT_K_CONSTANT) then if (CS%id_EnhK > 0) CS%EnhK(i,j,:) = LangEnhK Kdiffusivity(k,1) = Kdiffusivity(k,1) * LangEnhK @@ -788,26 +788,26 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! and no spurious extrema. if (surfBuoyFlux < 0.0) then if (CS%NLT_shape == NLT_SHAPE_CUBIC) then - do k = 2, G%ke + do k = 2, GV%ke sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then - do k = 2, G%ke + do k = 2, GV%ke sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then - do k = 2, G%ke + do k = 2, GV%ke sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then ! Sanity check (should agree with CVMix result using simple matching) - do k = 2, G%ke + do k = 2, GV%ke sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 nonLocalTrans(k,2) = nonLocalTrans(k,1) @@ -833,7 +833,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !BGR Now computing VT2 above so can modify for LT ! therefore, don't repeat this operation here ! CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & -! cellHeight(1:G%ke), & ! Depth of cell center [m] +! cellHeight(1:GV%ke), & ! Depth of cell center [m] ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] ! N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] ! CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -853,14 +853,14 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! Update output of routine if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then - do k=1, G%ke+1 + do k=1, GV%ke+1 Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero - do k=1, G%ke+1 + do k=1, GV%ke+1 if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m2_s_to_Z2_T * Kviscosity(k) @@ -919,20 +919,20 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! Local variables integer :: i, j, k, km1 ! Loop indices - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) - real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] - real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] - real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] - real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] - real, dimension( G%ke ) :: surfBuoyFlux2 - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] + real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] + real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] + real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] + real, dimension( GV%ke ) :: surfBuoyFlux2 + real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] ! for EOS calculation - real, dimension( 3*G%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] - real, dimension( 3*G%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] - real, dimension( 3*G%ke ) :: Temp_1D - real, dimension( 3*G%ke ) :: Salt_1D + real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] + real, dimension( 3*GV%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] + real, dimension( 3*GV%ke ) :: Temp_1D ! A column of temperatures [degC] + real, dimension( 3*GV%ke ) :: Salt_1D ! A column of salinities [ppt] real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho ! Gravitational acceleration divided by density in MKS units [m R-1 s-2 ~> m4 kg-1 s-2] @@ -954,8 +954,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! For Langmuir Calculations real :: LangEnhW ! Langmuir enhancement for turbulent velocity scale - real, dimension(G%ke) :: LangEnhVt2 ! Langmuir enhancement for unresolved shear - real, dimension(G%ke) :: U_H, V_H + real, dimension(GV%ke) :: LangEnhVt2 ! Langmuir enhancement for unresolved shear + real, dimension(GV%ke) :: U_H, V_H real :: MLD_GUESS, LA real :: surfHuS, surfHvS, surfUs, surfVs, wavedir, currentdir real :: VarUp, VarDn, M, VarLo, VarAvg @@ -994,7 +994,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! skip calling KPP for land points if (G%mask2dT(i,j)==0.) cycle - do k=1,G%ke + do k=1,GV%ke U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) enddo @@ -1013,7 +1013,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl iFaceHeight(1) = 0.0 ! BBL is all relative to the surface pRef = 0. ; if (associated(tv%p_surf)) pRef = tv%p_surf(i,j) hcorr = 0. - do k=1,G%ke + do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment @@ -1123,7 +1123,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! N2 (can be negative) and N (non-negative) on interfaces. ! deltaRho is non-local rho difference used for bulk Richardson number. ! CS%N is local N (with floor) used for unresolved shear calculation. - do k = 1, G%ke + do k = 1, GV%ke km1 = max(1, k-1) kk = 3*(k-1) deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1) @@ -1131,8 +1131,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) CS%N(i,j,k) = sqrt( max( N2_1d(k), 0.) ) enddo - N2_1d(G%ke+1 ) = 0.0 - CS%N(i,j,G%ke+1 ) = 0.0 + N2_1d(GV%ke+1 ) = 0.0 + CS%N(i,j,GV%ke+1 ) = 0.0 ! turbulent velocity scales w_s and w_m computed at the cell centers. ! Note that if sigma > CS%surf_layer_ext, then CVMix_kpp_compute_turbulent_scales @@ -1148,7 +1148,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !Compute CVMix VT2 CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & - zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center [m] + zt_cntr=cellHeight(1:GV%ke), & ! Depth of cell center [m] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1156,25 +1156,25 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !Modify CVMix VT2 IF (CS%LT_VT2_ENHANCEMENT) then IF (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then - do k=1,G%ke + do k=1,GV%ke LangEnhVT2(k) = CS%KPP_VT2_ENH_FAC enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. enhvt2 = sqrt(1.+(1.5*CS%La_SL(i,j))**(-2) + & (5.4*CS%La_SL(i,j))**(-4)) - do k=1,G%ke + do k=1,GV%ke LangEnhVT2(k) = enhvt2 enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_RW16) then !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. enhvt2 = 1. + 2.3*CS%La_SL(i,j)**(-0.5) - do k=1,G%ke + do k=1,GV%ke LangEnhVT2(k) = enhvt2 enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_LF17) then CS%CS=cvmix_get_kpp_real('c_s',CS%KPP_params) - do k=1,G%ke + do k=1,GV%ke WST = (max(0.,-buoy_scale*buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & (1.+0.49*CS%La_SL(i,j)**(-2.))) / & @@ -1189,14 +1189,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl LangEnhVT2(:) = 1.0 endif - do k=1,G%ke + do k=1,GV%ke CS%Vt2(i,j,k)=CS%Vt2(i,j,k)*LangEnhVT2(k) if (CS%id_EnhVt2 > 0) CS%EnhVt2(i,j,k)=LangEnhVT2(k) enddo ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & - zt_cntr = cellHeight(1:G%ke), & ! Depth of cell center [m] + zt_cntr = cellHeight(1:GV%ke), & ! Depth of cell center [m] delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] Vt_sqr_cntr=CS%Vt2(i,j,:), & @@ -1221,14 +1221,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! A hack to avoid KPP reaching the bottom. It was needed during development ! because KPP was unable to handle vanishingly small layers near the bottom. if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(GV%ke+1)) CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif ! apply some constraints on OBLdepth if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) @@ -1290,9 +1290,9 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) ! local real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] ! (negative in the ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] ! (negative in the ocean) real :: wc, ww, we, wn, ws ! averaging weights for smoothing real :: dh ! The local thickness used for calculating interface positions [m] @@ -1321,7 +1321,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. - do k=1,G%ke + do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment @@ -1349,7 +1349,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) if (CS%deepen_only) CS%OBLdepth(i,j) = max(CS%OBLdepth(i,j), OBLdepth_prev(i,j)) ! prevent OBL depths deeper than the bathymetric depth - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) enddo enddo @@ -1405,7 +1405,7 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & dtracer(:,:,:) = 0.0 !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux) - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & @@ -1417,7 +1417,7 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & ! Update tracer due to non-local redistribution of surface flux if (CS%applyNonLocalTrans) then !$OMP parallel do default(none) shared(dt, scalar, dtracer, G) - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) @@ -1432,7 +1432,7 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & if (CS%id_NLT_temp_budget > 0) then dtracer(:,:,:) = 0.0 !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, surfFlux, C_p, G, GV) - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & @@ -1466,7 +1466,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, dtracer(:,:,:) = 0.0 !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux) - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & @@ -1478,7 +1478,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, ! Update tracer due to non-local redistribution of surface flux if (CS%applyNonLocalTrans) then !$OMP parallel do default(none) shared(G, dt, scalar, dtracer) - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) @@ -1493,7 +1493,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, if (CS%id_NLT_saln_budget > 0) then dtracer(:,:,:) = 0.0 !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux) - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & @@ -1507,8 +1507,6 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, end subroutine KPP_NonLocalTransport_saln - - !> Clear pointers, deallocate memory subroutine KPP_end(CS) type(KPP_CS), pointer :: CS !< Control structure diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index ee6762f5f5..e487e616af 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -200,7 +200,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) pres_int(1) = 0. ; if (associated(tv%p_surf)) pres_int(1) = tv%p_surf(i,j) ! we don't have SST and SSS, so let's use values at top-most layer temp_int(1) = tv%T(i,j,1); salt_int(1) = tv%S(i,j,1) - do K=2,G%ke + do K=2,GV%ke ! pressure at interface pres_int(K) = pres_int(K-1) + (GV%g_Earth * GV%H_to_RZ) * h(i,j,k-1) ! temp and salt at interface @@ -217,13 +217,13 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! The "-1.0" below is needed so that the following criteria is satisfied: ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then "salt finger" ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then "diffusive convection" - do k=1,G%ke + do k=1,GV%ke alpha_dT(k) = -1.0*US%R_to_kg_m3*drho_dT(k) * dT(k) beta_dS(k) = US%R_to_kg_m3*drho_dS(k) * dS(k) enddo if (present(R_rho)) then - do k=1,G%ke + do k=1,GV%ke ! Set R_rho using Adcroft's rule of reciprocals. R_rho(i,j,k) = 0.0 ; if (abs(beta_dS(k)) > 0.0) R_rho(i,j,k) = alpha_dT(k) / beta_dS(k) ! avoid NaN's again for safety, perhaps unnecessarily. @@ -234,7 +234,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0.0 ! compute heights at cell center and interfaces - do k=1,G%ke + do k=1,GV%ke dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 @@ -251,9 +251,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) Sdiff_out=Kd1_S(:), & strat_param_num=alpha_dT(:), & strat_param_denom=beta_dS(:), & - nlev=G%ke, & - max_nlev=G%ke) - do K=1,G%ke+1 + nlev=GV%ke, & + max_nlev=GV%ke) + do K=1,GV%ke+1 Kd_T(i,j,K) = US%m2_s_to_Z2_T * Kd1_T(K) Kd_S(i,j,K) = US%m2_s_to_Z2_T * Kd1_S(K) enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index e969d9a640..1df0390697 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -81,13 +81,13 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real :: S2 ! Shear squared at an interface [T-2 ~> s-2] real :: dummy ! A dummy variable [nondim] real :: dRho ! Buoyancy differences [Z T-2 ~> m s-2] - real, dimension(2*(G%ke)) :: pres_1d ! A column of interface pressures [R L2 T-2 ~> Pa] - real, dimension(2*(G%ke)) :: temp_1d ! A column of temperatures [degC] - real, dimension(2*(G%ke)) :: salt_1d ! A column of salinities [ppt] - real, dimension(2*(G%ke)) :: rho_1d ! A column of densities at interface pressures [R ~> kg m-3] - real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number [nondim] - real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] - real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces [m2 s-1] + real, dimension(2*(GV%ke)) :: pres_1d ! A column of interface pressures [R L2 T-2 ~> Pa] + real, dimension(2*(GV%ke)) :: temp_1d ! A column of temperatures [degC] + real, dimension(2*(GV%ke)) :: salt_1d ! A column of salinities [ppt] + real, dimension(2*(GV%ke)) :: rho_1d ! A column of densities at interface pressures [R ~> kg m-3] + real, dimension(GV%ke+1) :: Ri_Grad !< Gradient Richardson number [nondim] + real, dimension(GV%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] + real, dimension(GV%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces [m2 s-1] real :: epsln !< Threshold to identify vanished layers [H ~> m or kg m-2] ! some constants @@ -103,7 +103,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) ! Richardson number computed for each cell in a column. pRef = 0. ; if (associated(tv%p_surf)) pRef = tv%p_surf(i,j) Ri_Grad(:)=1.e8 !Initialize w/ large Richardson value - do k=1,G%ke + do k=1,GV%ke ! pressure, temp, and saln for EOS ! kk+1 = k fields ! kk+2 = km1 fields @@ -126,7 +126,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, tv%eqn_of_state) ! N2 (can be negative) on interface - do k = 1, G%ke + do k = 1, GV%ke km1 = max(1, k-1) kk = 2*(k-1) DU = u_h(i,j,k) - u_h(i,j,km1) @@ -143,22 +143,22 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) enddo - Ri_grad(G%ke+1) = Ri_grad(G%ke) + Ri_grad(GV%ke+1) = Ri_grad(GV%ke) if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:) if (CS%smooth_ri) then ! 1) fill Ri_grad in vanished layers with adjacent value - do k = 2, G%ke + do k = 2, GV%ke if (h(i,j,k) <= epsln) Ri_grad(k) = Ri_grad(k-1) enddo - Ri_grad(G%ke+1) = Ri_grad(G%ke) + Ri_grad(GV%ke+1) = Ri_grad(GV%ke) ! 2) vertically smooth Ri with 1-2-1 filter dummy = 0.25 * Ri_grad(2) - Ri_grad(G%ke+1) = Ri_grad(G%ke) - do k = 3, G%ke + Ri_grad(GV%ke+1) = Ri_grad(GV%ke) + do k = 3, GV%ke Ri_Grad(k) = dummy + 0.5 * Ri_Grad(k) + 0.25 * Ri_grad(k+1) dummy = 0.25 * Ri_grad(k) enddo @@ -166,7 +166,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:) endif - do K=1,G%ke+1 + do K=1,GV%ke+1 Kvisc(K) = US%Z2_T_to_m2_s * kv(i,j,K) Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K) enddo @@ -175,9 +175,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), & Tdiff_out=Kdiff(:), & RICH=Ri_Grad(:), & - nlev=G%ke, & - max_nlev=G%ke) - do K=1,G%ke+1 + nlev=GV%ke, & + max_nlev=GV%ke) + do K=1,GV%ke+1 kv(i,j,K) = US%m2_s_to_Z2_T * Kvisc(K) kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K) enddo diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 756e67f244..c3ee727573 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -343,7 +343,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [Z2 T-1 ~> m2 s-1] integer :: i, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! set some parameters deg_to_rad = atan(1.0)/45.0 ! = PI/180 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1683e21fbe..1ee3fb4563 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -127,7 +127,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) ! row of points. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif @@ -260,7 +260,7 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff !$OMP parallel do default(private) shared(is,ie,js,je,h,h_neglect,dt,Kd_T,Kd_S,G,GV,T,S,nz) @@ -336,7 +336,7 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) real :: mc !< A layer's mass [R Z ~> kg m-2]. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif @@ -410,7 +410,7 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) T(i,j,1) = (b1(i)*h_tr)*T(i,j,1) S(i,j,1) = (b1(i)*h_tr)*S(i,j,1) enddo - do k=2,G%ke ; do i=is,ie + do k=2,GV%ke ; do i=is,ie c1(i,k) = eb(i,j,k-1) * b1(i) h_tr = hold(i,j,k) + GV%H_subroundoff b_denom_1 = h_tr + d1(i)*ea(i,j,k) @@ -419,7 +419,7 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) T(i,j,k) = b1(i) * (h_tr*T(i,j,k) + ea(i,j,k)*T(i,j,k-1)) S(i,j,k) = b1(i) * (h_tr*S(i,j,k) + ea(i,j,k)*S(i,j,k-1)) enddo ; enddo - do k=G%ke-1,1,-1 ; do i=is,ie + do k=GV%ke-1,1,-1 ; do i=is,ie T(i,j,k) = T(i,j,k) + c1(i,k+1)*T(i,j,k+1) S(i,j,k) = S(i,j,k) + c1(i,k+1)*S(i,j,k+1) enddo ; enddo @@ -458,7 +458,7 @@ subroutine triDiagTS_Eulerian(G, GV, is, ie, js, je, hold, ent, T, S) T(i,j,1) = (b1(i)*h_tr)*T(i,j,1) S(i,j,1) = (b1(i)*h_tr)*S(i,j,1) enddo - do k=2,G%ke ; do i=is,ie + do k=2,GV%ke ; do i=is,ie c1(i,k) = ent(i,j,K) * b1(i) h_tr = hold(i,j,k) + GV%H_subroundoff b_denom_1 = h_tr + d1(i)*ent(i,j,K) @@ -467,7 +467,7 @@ subroutine triDiagTS_Eulerian(G, GV, is, ie, js, je, hold, ent, T, S) T(i,j,k) = b1(i) * (h_tr*T(i,j,k) + ent(i,j,K)*T(i,j,k-1)) S(i,j,k) = b1(i) * (h_tr*S(i,j,k) + ent(i,j,K)*S(i,j,k-1)) enddo ; enddo - do k=G%ke-1,1,-1 ; do i=is,ie + do k=GV%ke-1,1,-1 ; do i=is,ie T(i,j,k) = T(i,j,k) + c1(i,k+1)*T(i,j,k+1) S(i,j,k) = S(i,j,k) + c1(i,k+1)*S(i,j,k+1) enddo ; enddo @@ -699,7 +699,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, gE_rho0 = US%L_to_Z**2*GV%g_Earth / (GV%Rho0) dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pRef_MLD(:) = 0.0 EOSdom(:) = EOS_domain(G%HI) @@ -835,7 +835,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) integer :: IT, iM integer :: i, j, is, ie, js, je, k, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pRef_MLD(:) = 0.0 mld(:,:,:) = 0.0 @@ -1084,7 +1084,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t integer :: i, j, is, ie, js, je, k, nz, n, nb character(len=45) :: mesg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Idt = 1.0 / dt @@ -1569,7 +1569,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. logical :: use_temperature ! True if thermodynamics are enabled. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2fb6a27542..b720fc9694 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3410,7 +3410,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif ! Initialize the diagnostic grid storage - call diag_grid_storage_init(CS%diag_grids_prev, G, diag) + call diag_grid_storage_init(CS%diag_grids_prev, G, GV, diag) end subroutine diabatic_driver_init diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index a83b18bf2f..0515f81725 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -72,7 +72,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) real :: tmp1 ! A temporary array. integer :: i, j, k, is, ie, js, je, nz, itt logical :: may_print - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "diapyc_energy_req_test: "// & "Module must be initialized before it is used.") @@ -260,7 +260,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & integer :: k, nz, itt, max_itt, k_cent logical :: surface_BL, bottom_BL, central, halves, debug logical :: old_PE_calc - nz = G%ke + nz = GV%ke h_neglect = GV%H_subroundoff debug = .true. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 4ed0dcc6bf..ee04b841c4 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -203,7 +203,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & integer :: kb_min ! The minimum value of kb in the current j-row. integer :: kb_min_act ! The minimum active value of kb in the current j-row. integer :: is1, ie1 ! The minimum and maximum active values of i in the current j-row. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff @@ -781,7 +781,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & enddo else ! not bulkmixedlayer - do k=K2,nz-1; + do k=K2,nz-1 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, EOSdom) do i=is,ie ; if (F(i,k) > 0.0) then ! Within a time step, a layer may entrain no more than @@ -931,7 +931,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke if (present(do_i_in)) then do i=is,ie ; do_i(i) = do_i_in(i) ; enddo @@ -1075,7 +1075,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, ! in roundoff and can be neglected [H ~> m or kg m-2]. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke ! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems. max_ent = 1.0e4*GV%m_to_H diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 3be6628b14..d9c0a76b43 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -94,7 +94,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, else is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec endif - nz = G%ke + nz = GV%ke if (.not.associated(tv%eqn_of_state)) return @@ -360,7 +360,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h else is = G%isc ; ie = G%iec endif - nz = G%ke + nz = GV%ke h_neglect = GV%H_subroundoff kap_dt_x2 = 2.0*Kddt diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 2ecaa4a78e..ceadaff821 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -122,7 +122,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) integer :: i, j, k, is, ie, js, je, nz, k2, i2 integer :: isj, iej, num_left, nkmb, k_tgt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif @@ -400,7 +400,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) logical :: calc_diags ! True if diagnostic tendencies are needed. integer :: i, j, k, is, ie, js, je, nz, i2, isj, iej - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index f5b9e7dbb7..9ab9a7fc34 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -99,7 +99,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) integer :: i, j, k, is, ie, js, je, nz, isd, ied, jsd, jed - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& @@ -184,7 +184,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0 EOSdom(:) = EOS_domain(G%HI) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 7cbbc33441..cbd2731d39 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -460,7 +460,7 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ ! Local variables real :: scale_opacity, scale_penSW ! Rescaling factors integer :: i, is, ie, k, nz, n - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke scale_opacity = 1.0 ; if (present(opacity_scale)) scale_opacity = opacity_scale scale_penSW = 1.0 ; if (present(penSW_scale)) scale_penSW = penSW_scale @@ -611,7 +611,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l I_Habs = optics%PenSW_absorb_Invlen h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 TKE_calc = (present(TKE) .and. present(dSV_dT)) @@ -835,7 +835,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & I_Habs = 1e3*GV%H_to_m ! optics%PenSW_absorb_Invlen h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) do i=is,ie ; h_heat(i) = 0.0 ; enddo @@ -943,7 +943,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) logical :: default_2018_answers logical :: use_scheme integer :: isd, ied, jsd, jed, nz, n - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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"// & diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index f21faa359d..625b6e34c4 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -91,7 +91,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) ! Local variables integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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.") @@ -192,7 +192,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, nkmb, nkml, k1, k2, k3, ks, nz_filt, kmax_d_ea - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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.") @@ -656,7 +656,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & real :: h1, h2 ! Temporary thicknesses [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, nkmb - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7b5dcc2be5..774d050f33 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -284,7 +284,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [Z2 ~> m2] - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("set_diffusivity(), MOM_set_diffusivity.F90") @@ -355,7 +355,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! set up arrays for tidal mixing diagnostics - call setup_tidal_diagnostics(G, CS%tidal_mixing_CSp) + call setup_tidal_diagnostics(G, GV, CS%tidal_mixing_CSp) if (CS%useKappaShear) then if (CS%debug) then @@ -760,7 +760,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz, i_rem, kmb, kb_min - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke I_dt = 1.0 / dt Omega2 = CS%omega**2 @@ -964,7 +964,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) H_neglect = GV%H_subroundoff @@ -1127,7 +1127,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke if (associated(tv%eqn_of_state)) then do i=is,ie @@ -1239,7 +1239,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & logical :: do_diag_Kd_BBL integer :: i, k, is, ie, nz, i_rem, kb_min - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke do_diag_Kd_BBL = associated(Kd_BBL) @@ -1510,7 +1510,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input ! at the bottom. - do k=G%ke,2,-1 + do k=GV%ke,2,-1 dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level [Z ~> m]. km1 = max(k-1, 1) dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above [Z ~> m]. @@ -1612,7 +1612,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, logical :: do_any, do_i(SZI_(G)) integer :: i, k, is, ie, nz, kml - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke Omega2 = CS%omega**2 C1_6 = 1.0 / 6.0 @@ -1765,7 +1765,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) local_open_v_BC = OBC%open_v_BCs_exist_globally endif ; endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) call MOM_error(FATAL,"set_BBL_TKE: "//& "Module must be initialized before it is used.") @@ -1932,7 +1932,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, k3, is, ie, nz, kmb - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke do k=2,nz-1 if (GV%g_prime(k+1) /= 0.0) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index a7bb80afc9..8d4704f516 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -353,7 +353,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) integer :: itt, maxitt=20 type(ocean_OBC_type), pointer :: OBC => NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff @@ -1323,7 +1323,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n type(ocean_OBC_type), pointer :: OBC => NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 nkmb = GV%nk_rho_varies ; nkml = GV%nkml diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index dcd0ac4e02..11951e6f0c 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -133,7 +133,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & CS%do_i_mean_sponge = present(Iresttime_i_mean) - CS%nz = G%ke + CS%nz = GV%ke ! CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec ! CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. @@ -169,7 +169,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & if (CS%do_i_mean_sponge) then allocate(CS%Iresttime_im(G%jsd:G%jed)) ; CS%Iresttime_im(:) = 0.0 - allocate(CS%Ref_eta_im(G%jsd:G%jed,G%ke+1)) ; CS%Ref_eta_im(:,:) = 0.0 + allocate(CS%Ref_eta_im(G%jsd:G%jed,GV%ke+1)) ; CS%Ref_eta_im(:,:) = 0.0 do j=G%jsc,G%jec CS%Iresttime_im(j) = Iresttime_i_mean(j) @@ -382,7 +382,7 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). [nondim] real :: Idt ! 1.0/dt times a height unit conversion factor [m H-1 T-1 ~> s-1 or m3 kg-1 s-1]. integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return if (CS%bulkmixedlayer) nkmb = GV%nk_rho_varies diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index bf70067675..9401b06662 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -761,7 +761,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 - do k=1,G%ke + do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix. dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) @@ -771,7 +771,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - call CVMix_compute_Simmons_invariant( nlev = G%ke, & + call CVMix_compute_Simmons_invariant( nlev = GV%ke, & energy_flux = CS%tidal_qe_2d(i,j), & rho = rho_fw, & SimmonsCoeff = Simmons_coeff, & @@ -787,35 +787,35 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! XXX: Temporary de-scaling of N2_int(i,:) into a temporary variable - do K=1,G%ke+1 + do K=1,GV%ke+1 N2_int_i(K) = US%s_to_T**2 * N2_int(i,K) enddo - call CVMix_coeffs_tidal( Mdiff_out = Kv_tidal, & - Tdiff_out = Kd_tidal, & - Nsqr = N2_int_i, & - OceanDepth = -iFaceHeight(G%ke+1),& - SimmonsCoeff = Simmons_coeff, & - vert_dep = vert_dep, & - nlev = G%ke, & - max_nlev = G%ke, & - CVMix_params = CS%CVMix_glb_params, & + call CVMix_coeffs_tidal( Mdiff_out = Kv_tidal, & + Tdiff_out = Kd_tidal, & + Nsqr = N2_int_i, & + OceanDepth = -iFaceHeight(GV%ke+1),& + SimmonsCoeff = Simmons_coeff, & + vert_dep = vert_dep, & + nlev = GV%ke, & + max_nlev = GV%ke, & + CVMix_params = CS%CVMix_glb_params, & CVMix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity if (present(Kd_lay)) then - do k=1,G%ke + do k=1,GV%ke Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo endif if (present(Kd_int)) then - do K=1,G%ke+1 + do K=1,GV%ke+1 Kd_int(i,K) = Kd_int(i,K) + (US%m2_s_to_Z2_T * Kd_tidal(K)) enddo endif ! Update viscosity with the proper unit conversion. if (associated(Kv)) then - do K=1,G%ke+1 + do K=1,GV%ke+1 Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1. enddo endif @@ -841,7 +841,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! TODO: correct exp_hab_zetar shapes in CVMix_compute_Schmittner_invariant ! and CVMix_compute_SchmittnerCoeff low subroutines - allocate(exp_hab_zetar(G%ke+1,G%ke+1)) + allocate(exp_hab_zetar(GV%ke+1,GV%ke+1)) do i=is,ie @@ -849,7 +849,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 - do k=1,G%ke + do k=1,GV%ke h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. ! cell center and cell bottom in meters (negative values in the ocean) dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0) @@ -862,7 +862,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv SchmittnerSocn = 0.0 ! TODO: compute this ! form the time-invariant part of Schmittner coefficient term - call CVMix_compute_Schmittner_invariant(nlev = G%ke, & + call CVMix_compute_Schmittner_invariant(nlev = GV%ke, & VertDep = vert_dep, & efficiency = CS%Mu_itides, & rho = rho_fw, & @@ -876,11 +876,11 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! remap from input z coordinate to model coordinate: tidal_qe_md = 0.0 call remapping_core_h(CS%remap_cs, size(CS%h_src), CS%h_src, CS%tidal_qe_3d_in(i,j,:), & - G%ke, h_m, tidal_qe_md) + GV%ke, h_m, tidal_qe_md) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. - call CVMix_compute_SchmittnerCoeff( nlev = G%ke, & + call CVMix_compute_SchmittnerCoeff( nlev = GV%ke, & energy_flux = tidal_qe_md(:), & rho = rho_fw, & SchmittnerCoeff = Schmittner_coeff, & @@ -888,17 +888,17 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv CVmix_tidal_params_user = CS%CVMix_tidal_params) ! XXX: Temporary de-scaling of N2_int(i,:) into a temporary variable - do k=1,G%ke+1 + do k=1,GV%ke+1 N2_int_i(k) = US%s_to_T**2 * N2_int(i,k) enddo call CVMix_coeffs_tidal_schmittner( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & Nsqr = N2_int_i, & - OceanDepth = -iFaceHeight(G%ke+1), & + OceanDepth = -iFaceHeight(GV%ke+1), & vert_dep = vert_dep, & - nlev = G%ke, & - max_nlev = G%ke, & + nlev = GV%ke, & + max_nlev = GV%ke, & SchmittnerCoeff = Schmittner_coeff, & SchmittnerSouthernOcean = SchmittnerSocn, & CVmix_params = CS%CVMix_glb_params, & @@ -906,19 +906,19 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! Update diffusivity if (present(Kd_lay)) then - do k=1,G%ke + do k=1,GV%ke Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo endif if (present(Kd_int)) then - do K=1,G%ke+1 + do K=1,GV%ke+1 Kd_int(i,K) = Kd_int(i,K) + (US%m2_s_to_Z2_T * Kd_tidal(K)) enddo endif ! Update viscosity if (associated(Kv)) then - do K=1,G%ke+1 + do K=1,GV%ke+1 Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1. enddo endif @@ -1034,7 +1034,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, integer :: a, fr, m type(tidal_mixing_diags), pointer :: dd => NULL() - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = GV%ke dd => CS%dd if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return @@ -1409,15 +1409,16 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, end subroutine add_int_tide_diffusivity !> Sets up diagnostics arrays for tidal mixing. -subroutine setup_tidal_diagnostics(G,CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module +subroutine setup_tidal_diagnostics(G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local integer :: isd, ied, jsd, jed, nz type(tidal_mixing_diags), pointer :: dd => NULL() - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke + 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)) then @@ -1585,10 +1586,10 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) 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 ! local - integer :: i, j, isd, ied, jsd, jed, nz + integer :: i, j, isd, ied, jsd, jed real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed select case (uppercase(tidal_energy_type(1:4))) case ('JAYN') ! Jayne 2009 diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 7786bf5b46..a41a47b254 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -218,7 +218,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n 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 = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") @@ -534,7 +534,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") @@ -690,7 +690,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! finding z_clear. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(coef): "// & "Module must be initialized before it is used.") @@ -701,11 +701,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val if (CS%id_Kv_u > 0) then - allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) ; Kv_u(:,:,:) = 0.0 + allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ; Kv_u(:,:,:) = 0.0 endif if (CS%id_Kv_v > 0) then - allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) ; Kv_v(:,:,:) = 0.0 + allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ; Kv_v(:,:,:) = 0.0 endif if (CS%debug .or. (CS%id_hML_u > 0)) then @@ -1155,7 +1155,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif - nz = G%ke + nz = GV%ke h_neglect = GV%H_subroundoff if (CS%answers_2018) then @@ -1394,7 +1394,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] logical :: trunc_any, dowrite(SZIB_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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 maxvel = CS%maxvel @@ -1614,7 +1614,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & if (GV%Boussinesq) then; thickness_units = "m" else; thickness_units = "kg m-2"; endif - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 CS%diag => diag ; CS%ntrunc => ntrunc ; ntrunc = 0 diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 5503287c50..349154cfe6 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -184,7 +184,7 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & integer :: IsdB, IedB, JsdB, JedB if (.not.associated(CS)) return - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB h_neglect = GV%H_subroundoff @@ -283,7 +283,7 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G real :: mmax ! The global maximum melting rate [R Z T-1 ~> kg m-2 s-1] character(len=256) :: mesg ! The text of an error message integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 9aad84a6dd..cdcd121a2c 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -345,12 +345,12 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & if (.not.restart .or. (CS%tracers_may_reinit .and. & .not.query_initialized(CS%CFC11, CS%CFC11_name, CS%restart_CSp))) & call init_tracer_CFC(h, CS%CFC11, CS%CFC11_name, CS%CFC11_land_val, & - CS%CFC11_IC_val, G, US, CS) + CS%CFC11_IC_val, G, GV, US, CS) if (.not.restart .or. (CS%tracers_may_reinit .and. & .not.query_initialized(CS%CFC12, CS%CFC12_name, CS%restart_CSp))) & call init_tracer_CFC(h, CS%CFC12, CS%CFC12_name, CS%CFC12_land_val, & - CS%CFC12_IC_val, G, US, CS) + CS%CFC12_IC_val, G, GV, US, CS) if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. @@ -359,8 +359,9 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & end subroutine initialize_OCMIP2_CFC !>This subroutine initializes a tracer array. -subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, US, CS) +subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr !< The tracer concentration array @@ -374,16 +375,16 @@ subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, US, CS) logical :: OK integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (len_trim(CS%IC_file) > 0) then ! Read the tracer concentrations from a netcdf file. if (.not.file_exists(CS%IC_file, G%Domain)) & call MOM_error(FATAL, "initialize_OCMIP2_CFC: Unable to open "//CS%IC_file) if (CS%Z_IC_file) then - OK = tracer_Z_init(tr, h, CS%IC_file, name, G, US) + OK = tracer_Z_init(tr, h, CS%IC_file, name, G, GV, US) if (.not.OK) then - OK = tracer_Z_init(tr, h, CS%IC_file, trim(name), G, US) + OK = tracer_Z_init(tr, h, CS%IC_file, trim(name), G, GV, US) if (.not.OK) call MOM_error(FATAL,"initialize_OCMIP2_CFC: "//& "Unable to read "//trim(name)//" from "//& trim(CS%IC_file)//".") diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 1ecf9629d8..29a575af77 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -252,14 +252,14 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, character(len=fm_string_len) :: g_tracer_name real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr - real, dimension(G%isd:G%ied, G%jsd:G%jed,1:G%ke) :: grid_tmask - integer, dimension(G%isd:G%ied, G%jsd:G%jed) :: grid_kmt + real, dimension(G%isd:G%ied, G%jsd:G%jed, 1:GV%ke) :: grid_tmask + integer, dimension(G%isd:G%ied, G%jsd:G%jed) :: grid_kmt !! 2010/02/04 Add code to re-initialize Generic Tracers if needed during a model simulation !! By default, restart cpio should not contain a Generic Tracer IC file and step below will be skipped. !! Ideally, the generic tracer IC file should have the tracers on Z levels. - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = G%ke + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke CS%diag=>diag !Get the tracer list @@ -322,9 +322,9 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, if (.not.file_exists(CS%IC_file)) call MOM_error(FATAL, & "initialize_MOM_Generic_tracer: Unable to open "//CS%IC_file) if (CS%Z_IC_file) then - OK = tracer_Z_init(tr_ptr, h, CS%IC_file, g_tracer_name, G, US) + OK = tracer_Z_init(tr_ptr, h, CS%IC_file, g_tracer_name, G, GV, US) if (.not.OK) then - OK = tracer_Z_init(tr_ptr, h, CS%IC_file, trim(g_tracer_name), G, US) + OK = tracer_Z_init(tr_ptr, h, CS%IC_file, trim(g_tracer_name), G, GV, US) if (.not.OK) call MOM_error(FATAL,"initialize_MOM_Generic_tracer: "//& "Unable to read "//trim(g_tracer_name)//" from "//& trim(CS%IC_file)//".") @@ -364,7 +364,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, do j = G%jsd, G%jed ; do i = G%isd, G%ied if (G%mask2dT(i,j) > 0) then grid_tmask(i,j,:) = 1.0 - grid_kmt(i,j) = G%ke ! Tell the code that a layer thicker than 1m is the bottom layer. + grid_kmt(i,j) = GV%ke ! Tell the code that a layer thicker than 1m is the bottom layer. endif enddo ; enddo call g_tracer_set_common(G%isc,G%iec,G%jsc,G%jec,G%isd,G%ied,G%jsd,G%jed,& @@ -434,11 +434,11 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, real :: dz_ml(SZI_(G),SZJ_(G)) ! The mixed layer depth in the MKS units used for generic tracers [m] real :: sosga - real, dimension(G%isd:G%ied,G%jsd:G%jed,G%ke) :: rho_dzt, dzt + real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke) :: rho_dzt, dzt real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work integer :: i, j, k, isc, iec, jsc, jec, nk - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = G%ke + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke !Get the tracer list if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL,& @@ -588,7 +588,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde character(len=128), parameter :: sub_name = 'MOM_generic_tracer_stock' integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke MOM_generic_tracer_stock = 0 if (.not.associated(CS)) return @@ -663,10 +663,10 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg real, dimension(:,:,:),pointer :: grid_tmask integer :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau - integer :: i, j, k, is, ie, js, je, nz, m + integer :: i, j, k, is, ie, js, je, m real, allocatable, dimension(:) :: geo_z - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec MOM_generic_tracer_min_max = 0 if (.not.associated(CS)) return @@ -716,8 +716,9 @@ end function MOM_generic_tracer_min_max !! !! This subroutine sets up the fields that the coupler needs to calculate the !! CFC fluxes between the ocean and atmosphere. - subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, CS) + subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] @@ -727,8 +728,8 @@ subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, CS) real :: sosga character(len=128), parameter :: sub_name = 'MOM_generic_tracer_surface_state' - real, dimension(G%isd:G%ied,G%jsd:G%jed,1:G%ke,1) :: rho0 - real, dimension(G%isd:G%ied,G%jsd:G%jed,1:G%ke) :: dzt + real, dimension(G%isd:G%ied,G%jsd:G%jed,1:GV%ke,1) :: rho0 + real, dimension(G%isd:G%ied,G%jsd:G%jed,1:GV%ke) :: dzt type(g_tracer_type), pointer :: g_tracer !Set coupler values diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 465174f676..547385c5b5 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -158,8 +158,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) real, dimension(SZI_(G),SZJB_(G)) :: vFlx_bulk !< Total calculated bulk-layer v-flux for the tracer real, dimension(SZIB_(G),SZJ_(G)) :: uwork_2d !< Layer summed u-flux transport real, dimension(SZI_(G),SZJB_(G)) :: vwork_2d !< Layer summed v-flux transport - real, dimension(SZI_(G),SZJ_(G),G%ke) :: tendency !< tendency array for diagn - real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d !< depth integrated content tendency for diagn + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tendency !< tendency array for diagnostics + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d !< depth integrated content tendency for diagnostics type(tracer_type), pointer :: Tracer => NULL() !< Pointer to the current tracer integer :: remap_method !< Reconstruction method integer :: i,j,k,m !< indices to loop over @@ -182,7 +182,7 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) ! Interpolate state to interface do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - call build_reconstructions_1d( CS%remap_CS, G%ke, h(i,j,:), tracer%t(i,j,:), ppoly0_coefs(i,j,:,:), & + call build_reconstructions_1d( CS%remap_CS, GV%ke, h(i,j,:), tracer%t(i,j,:), ppoly0_coefs(i,j,:,:), & ppoly0_E(i,j,:,:), ppoly_S, remap_method, GV%H_subroundoff, GV%H_subroundoff) enddo ; enddo diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index e64f5f69ce..5d5acf3e1b 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -113,9 +113,10 @@ module MOM_neutral_diffusion contains !> Read parameters and allocate control structure for neutral_diffusion module. -logical function neutral_diffusion_init(Time, G, US, param_file, diag, EOS, diabatic_CSp, CS) +logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, diabatic_CSp, CS) type(time_type), target, intent(in) :: Time !< Time structure type(ocean_grid_type), intent(in) :: G !< 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(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure @@ -244,11 +245,11 @@ logical function neutral_diffusion_init(Time, G, US, param_file, diag, EOS, diab ! units="m2 s-1", default=0.0) ! call closeParameterBlock(param_file) if (CS%continuous_reconstruction) then - CS%nsurf = 2*G%ke+2 ! Continuous reconstruction means that every interface has two connections + CS%nsurf = 2*GV%ke+2 ! Continuous reconstruction means that every interface has two connections allocate(CS%dRdT(SZI_(G),SZJ_(G),SZK_(G)+1)) ; CS%dRdT(:,:,:) = 0. allocate(CS%dRdS(SZI_(G),SZJ_(G),SZK_(G)+1)) ; CS%dRdS(:,:,:) = 0. else - CS%nsurf = 4*G%ke ! Discontinuous means that every interface has four connections + CS%nsurf = 4*GV%ke ! Discontinuous means that every interface has four connections allocate(CS%T_i(SZI_(G),SZJ_(G),SZK_(G),2)) ; CS%T_i(:,:,:,:) = 0. allocate(CS%S_i(SZI_(G),SZJ_(G),SZK_(G),2)) ; CS%S_i(:,:,:,:) = 0. allocate(CS%P_i(SZI_(G),SZJ_(G),SZK_(G),2)) ; CS%P_i(:,:,:,:) = 0. @@ -323,7 +324,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) call pass_var(hbl, G%Domain) ! get k-indices and zeta do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 - call boundary_k_range(SURFACE, G%ke, h(i,j,:), hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) + call boundary_k_range(SURFACE, GV%ke, h(i,j,:), hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) enddo; enddo ! TODO: add similar code for BOTTOM boundary layer endif @@ -361,7 +362,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) else CS%Pint(:,:,1) = 0. endif - do k=1,G%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 CS%Pint(i,j,k+1) = CS%Pint(i,j,k) + h(i,j,k)*(GV%g_Earth*GV%H_to_RZ) enddo ; enddo ; enddo @@ -379,7 +380,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) CS%P_i(i,j,1,2) = h(i,j,1)*(GV%H_to_RZ*GV%g_Earth) enddo ; enddo endif - do k=2,G%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + do k=2,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 CS%P_i(i,j,k,1) = CS%P_i(i,j,k-1,2) CS%P_i(i,j,k,2) = CS%P_i(i,j,k-1,2) + h(i,j,k)*(GV%H_to_RZ*GV%g_Earth) enddo ; enddo ; enddo @@ -390,16 +391,16 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Interpolate state to interface do i = G%isc-1, G%iec+1 if (CS%continuous_reconstruction) then - call interface_scalar(G%ke, h(i,j,:), T(i,j,:), CS%Tint(i,j,:), 2, h_neglect) - call interface_scalar(G%ke, h(i,j,:), S(i,j,:), CS%Sint(i,j,:), 2, h_neglect) + call interface_scalar(GV%ke, h(i,j,:), T(i,j,:), CS%Tint(i,j,:), 2, h_neglect) + call interface_scalar(GV%ke, h(i,j,:), S(i,j,:), CS%Sint(i,j,:), 2, h_neglect) else - call build_reconstructions_1d( CS%remap_CS, G%ke, h(i,j,:), T(i,j,:), CS%ppoly_coeffs_T(i,j,:,:), & + call build_reconstructions_1d( CS%remap_CS, GV%ke, h(i,j,:), T(i,j,:), CS%ppoly_coeffs_T(i,j,:,:), & CS%T_i(i,j,:,:), ppoly_r_S, iMethod, h_neglect, h_neglect_edge ) - call build_reconstructions_1d( CS%remap_CS, G%ke, h(i,j,:), S(i,j,:), CS%ppoly_coeffs_S(i,j,:,:), & + call build_reconstructions_1d( CS%remap_CS, GV%ke, h(i,j,:), S(i,j,:), CS%ppoly_coeffs_S(i,j,:,:), & CS%S_i(i,j,:,:), ppoly_r_S, iMethod, h_neglect, h_neglect_edge ) ! In the current ALE formulation, interface values are not exactly at the 0. or 1. of the ! polynomial reconstructions - do k=1,G%ke + do k=1,GV%ke CS%T_i(i,j,k,1) = evaluation_polynomial( CS%ppoly_coeffs_T(i,j,k,:), CS%deg+1, 0. ) CS%T_i(i,j,k,2) = evaluation_polynomial( CS%ppoly_coeffs_T(i,j,k,:), CS%deg+1, 1. ) CS%S_i(i,j,k,1) = evaluation_polynomial( CS%ppoly_coeffs_S(i,j,k,:), CS%deg+1, 0. ) @@ -410,13 +411,13 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Continuous reconstruction if (CS%continuous_reconstruction) then - do k = 1, G%ke+1 + do k = 1, GV%ke+1 if (CS%ref_pres<0) ref_pres(:) = CS%Pint(:,j,k) call calculate_density_derivs(CS%Tint(:,j,k), CS%Sint(:,j,k), ref_pres, CS%dRdT(:,j,k), & CS%dRdS(:,j,k), CS%EOS, EOSdom) enddo else ! Discontinuous reconstruction - do k = 1, G%ke + do k = 1, GV%ke if (CS%ref_pres<0) ref_pres(:) = CS%Pint(:,j,k) ! Calculate derivatives for the top interface call calculate_density_derivs(CS%T_i(:,j,k,1), CS%S_i(:,j,k,1), ref_pres, CS%dRdT_i(:,j,k,1), & @@ -431,7 +432,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) if (.not. CS%continuous_reconstruction) then do j = G%jsc-1, G%jec+1 ; do i = G%isc-1, G%iec+1 - call mark_unstable_cells( CS, G%ke, CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%P_i(i,j,:,:), CS%stable_cell(i,j,:) ) + call mark_unstable_cells( CS, GV%ke, CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%P_i(i,j,:,:), CS%stable_cell(i,j,:) ) if (CS%interior_only) then if (.not. CS%stable_cell(i,j,k_bot(i,j))) zeta_bot(i,j) = -1. ! set values in the surface and bottom boundary layer to false. @@ -457,13 +458,13 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) do j = G%jsc, G%jec ; do I = G%isc-1, G%iec if (G%mask2dCu(I,j) > 0.) then if (CS%continuous_reconstruction) then - call find_neutral_surface_positions_continuous(G%ke, & + call find_neutral_surface_positions_continuous(GV%ke, & CS%Pint(i,j,:), CS%Tint(i,j,:), CS%Sint(i,j,:), CS%dRdT(i,j,:), CS%dRdS(i,j,:), & CS%Pint(i+1,j,:), CS%Tint(i+1,j,:), CS%Sint(i+1,j,:), CS%dRdT(i+1,j,:), CS%dRdS(i+1,j,:), & CS%uPoL(I,j,:), CS%uPoR(I,j,:), CS%uKoL(I,j,:), CS%uKoR(I,j,:), CS%uhEff(I,j,:), & k_bot(I,j), k_bot(I+1,j), zeta_bot(I,j), zeta_bot(I+1,j)) else - call find_neutral_surface_positions_discontinuous(CS, G%ke, & + call find_neutral_surface_positions_discontinuous(CS, GV%ke, & CS%P_i(i,j,:,:), h(i,j,:), CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%ppoly_coeffs_T(i,j,:,:), & CS%ppoly_coeffs_S(i,j,:,:),CS%stable_cell(i,j,:), & CS%P_i(i+1,j,:,:), h(i+1,j,:), CS%T_i(i+1,j,:,:), CS%S_i(i+1,j,:,:), CS%ppoly_coeffs_T(i+1,j,:,:), & @@ -478,13 +479,13 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) do J = G%jsc-1, G%jec ; do i = G%isc, G%iec if (G%mask2dCv(i,J) > 0.) then if (CS%continuous_reconstruction) then - call find_neutral_surface_positions_continuous(G%ke, & + call find_neutral_surface_positions_continuous(GV%ke, & CS%Pint(i,j,:), CS%Tint(i,j,:), CS%Sint(i,j,:), CS%dRdT(i,j,:), CS%dRdS(i,j,:), & CS%Pint(i,j+1,:), CS%Tint(i,j+1,:), CS%Sint(i,j+1,:), CS%dRdT(i,j+1,:), CS%dRdS(i,j+1,:), & CS%vPoL(i,J,:), CS%vPoR(i,J,:), CS%vKoL(i,J,:), CS%vKoR(i,J,:), CS%vhEff(i,J,:), & k_bot(i,J), k_bot(i,J+1), zeta_bot(i,J), zeta_bot(i,J+1)) else - call find_neutral_surface_positions_discontinuous(CS, G%ke, & + call find_neutral_surface_positions_discontinuous(CS, GV%ke, & CS%P_i(i,j,:,:), h(i,j,:), CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%ppoly_coeffs_T(i,j,:,:), & CS%ppoly_coeffs_S(i,j,:,:),CS%stable_cell(i,j,:), & CS%P_i(i,j+1,:,:), h(i,j+1,:), CS%T_i(i,j+1,:,:), CS%S_i(i,j+1,:,:), CS%ppoly_coeffs_T(i,j+1,:,:), & @@ -542,11 +543,11 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) real, dimension(SZIB_(G),SZJ_(G),CS%nsurf-1) :: uFlx ! Zonal flux of tracer [H conc ~> m conc or conc kg m-2] real, dimension(SZI_(G),SZJB_(G),CS%nsurf-1) :: vFlx ! Meridional flux of tracer ! [H conc ~> m conc or conc kg m-2] - real, dimension(SZI_(G),SZJ_(G),G%ke) :: tendency ! tendency array for diagn + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tendency ! tendency array for diagn real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn real, dimension(SZIB_(G),SZJ_(G)) :: trans_x_2d ! depth integrated diffusive tracer x-transport diagn real, dimension(SZI_(G),SZJB_(G)) :: trans_y_2d ! depth integrated diffusive tracer y-transport diagn - real, dimension(G%ke) :: dTracer ! change in tracer concentration due to ndiffusion + real, dimension(SZK_(GV)) :: dTracer ! change in tracer concentration due to ndiffusion type(tracer_type), pointer :: Tracer => NULL() ! Pointer to the current tracer diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 3895e8a116..7b1ae7bb2d 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -336,7 +336,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call hchksum(h_vol,"h_vol before advect",G%HI) call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI) write(debug_msg, '(A,I4.4)') 'Before advect ', iter - call MOM_tracer_chkinv(debug_msg, G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv(debug_msg, G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, CS%US, & @@ -357,7 +357,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock if (CS%debug) then call hchksum(h_new,"h_new before ALE",G%HI) write(debug_msg, '(A,I4.4)') 'Before ALE ', iter - call MOM_tracer_chkinv(debug_msg, G, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_begin(id_clock_ALE) call ALE_main_offline(G, GV, h_new, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, CS%dt_offline) @@ -366,7 +366,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock if (CS%debug) then call hchksum(h_new,"h_new after ALE",G%HI) write(debug_msg, '(A,I4.4)') 'After ALE ', iter - call MOM_tracer_chkinv(debug_msg, G, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif endif @@ -408,7 +408,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock if (CS%debug) then call hchksum(h_pre,"h after offline_advection_ale",G%HI) call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI) - call MOM_tracer_chkinv("After offline_advection_ale", G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_end(CS%id_clock_offline_adv) @@ -476,7 +476,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (converged) return if (CS%debug) then - call MOM_tracer_chkinv("Before redistribute ", G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before redistribute ", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_begin(CS%id_clock_redistribute) @@ -607,7 +607,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%debug) then call hchksum(h_pre,"h_pre after redistribute",G%HI) call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI) - call MOM_tracer_chkinv("after redistribute ", G, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) + call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) endif call cpu_clock_end(CS%id_clock_redistribute) @@ -683,7 +683,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e call hchksum(h_pre,"h_pre before offline_diabatic_ale",CS%G%HI) call hchksum(eatr,"eatr before offline_diabatic_ale",CS%G%HI) call hchksum(ebtr,"ebtr before offline_diabatic_ale",CS%G%HI) - call MOM_tracer_chkinv("Before offline_diabatic_ale", CS%G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before offline_diabatic_ale", CS%G, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif eatr(:,:,:) = 0. @@ -747,7 +747,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e call hchksum(h_pre,"h_pre after offline_diabatic_ale",CS%G%HI) call hchksum(eatr,"eatr after offline_diabatic_ale",CS%G%HI) call hchksum(ebtr,"ebtr after offline_diabatic_ale",CS%G%HI) - call MOM_tracer_chkinv("After offline_diabatic_ale", CS%G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("After offline_diabatic_ale", CS%G, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_end(CS%id_clock_offline_diabatic) @@ -786,8 +786,8 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) enddo ; enddo if (CS%debug) then - call hchksum(h,"h before fluxes into ocean",G%HI) - call MOM_tracer_chkinv("Before fluxes into ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h, "h before fluxes into ocean", G%HI) + call MOM_tracer_chkinv("Before fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif do m = 1,CS%tracer_reg%ntr ! Layer thicknesses should only be updated after the last tracer is finished @@ -796,8 +796,8 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) enddo if (CS%debug) then - call hchksum(h,"h after fluxes into ocean",G%HI) - call MOM_tracer_chkinv("After fluxes into ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h, "h after fluxes into ocean", G%HI) + call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif ! Now that fluxes into the ocean are done, save the negative fluxes for later @@ -825,7 +825,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) if (CS%debug) then call hchksum(h,"h before fluxes out of ocean",G%HI) - call MOM_tracer_chkinv("Before fluxes out of ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif do m = 1, CS%tracer_reg%ntr ! Layer thicknesses should only be updated after the last tracer is finished @@ -835,7 +835,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) enddo if (CS%debug) then call hchksum(h,"h after fluxes out of ocean",G%HI) - call MOM_tracer_chkinv("Before fluxes out of ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif end subroutine offline_fw_fluxes_out_ocean diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index ac6242785e..17b34e210e 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -9,6 +9,7 @@ module MOM_tracer_Z_init use MOM_io, only : MOM_read_data use MOM_EOS, only : EOS_type, calculate_density, calculate_density_derivs, EOS_domain use MOM_unit_scaling, only : unit_scale_type +use MOM_verticalGrid, only : verticalGrid_type use netcdf @@ -27,9 +28,10 @@ module MOM_tracer_Z_init !> This function initializes a tracer by reading a Z-space file, returning !! .true. if this appears to have been successful, and false otherwise. -function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) +function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_val) logical :: tracer_Z_init !< A return code indicating if the initialization has been successful 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_(G)), & intent(out) :: tr !< The tracer to initialize @@ -75,7 +77,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) character(len=80) :: loc_msg integer :: k_top, k_bot, k_bot_prev, k_start integer :: i, j, k, kz, is, ie, js, je, nz, nz_in - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke landval = 0.0 ; if (present(land_val)) landval = land_val @@ -610,8 +612,10 @@ 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, US, eos, h_massless) +subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, k_start, G, GV, US, & + 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_(G)), & intent(inout) :: temp !< potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -651,7 +655,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, kz, is, ie, js, je, nz, itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! These hard coded parameters need to be set properly. S_min = 0.5 ; S_max = 65.0 diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 6b9a12f696..67b7ef0497 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -466,7 +466,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim integer :: i, j, is, ie, js, je, k, nz, n, nsw character(len=45) :: mesg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! If no freshwater fluxes, nothing needs to be done in this routine if ( (.not. associated(fluxes%netMassIn)) .or. (.not. associated(fluxes%netMassOut)) ) return diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 4c7c27c7e6..88d42ad2b2 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -722,10 +722,11 @@ end subroutine store_stocks !> This subroutine calls all registered tracer packages to enable them to !! add to the surface state returned to the coupler. These routines are optional. -subroutine call_tracer_surface_state(sfc_state, h, G, CS) +subroutine call_tracer_surface_state(sfc_state, h, G, GV, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. 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_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a @@ -752,7 +753,7 @@ subroutine call_tracer_surface_state(sfc_state, h, G, CS) if (CS%use_OCMIP2_CFC) & call OCMIP2_CFC_surface_state(sfc_state, h, G, CS%OCMIP2_CFC_CSp) if (CS%use_MOM_generic_tracer) & - call MOM_generic_tracer_surface_state(sfc_state, h, G, CS%MOM_generic_tracer_CSp) + call MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS%MOM_generic_tracer_CSp) end subroutine call_tracer_surface_state diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 43ede7cff5..0159e3add2 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -1430,9 +1430,10 @@ end subroutine tracer_epipycnal_ML_diff !> Initialize lateral tracer diffusion module -subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, diabatic_CSp, CS) +subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic_CSp, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS @@ -1507,7 +1508,7 @@ subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, diabatic_CSp units="nondim", default=1.0) endif - CS%use_neutral_diffusion = neutral_diffusion_init(Time, G, US, param_file, diag, EOS, & + CS%use_neutral_diffusion = neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, & diabatic_CSp, CS%neutral_diffusion_CSp ) if (CS%use_neutral_diffusion .and. CS%Diffuse_ML_interior) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "USE_NEUTRAL_DIFFUSION and DIFFUSE_ML_TO_INTERIOR are mutually exclusive!") diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index cb8f1716fe..cec419d068 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -371,7 +371,7 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) type(tracer_type), pointer :: Tr=>NULL() integer :: i, j, k, is, ie, js, je, nz, m, m2, nTr_in integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -695,7 +695,7 @@ subroutine postALE_tracer_diagnostics(Reg, G, GV, diag, dt) real :: work(SZI_(G),SZJ_(G),SZK_(G)) real :: Idt ! The inverse of the time step [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz, m, m2 - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! The "if" is to avoid NaNs if the diagnostic is called for a zero length interval Idt = 0.0 ; if (dt /= 0.0) Idt = 1.0 / dt @@ -729,7 +729,7 @@ subroutine post_tracer_diagnostics_at_sync(Reg, h, diag_prev, diag, G, GV, dt) real :: Idt ! The inverse of the time step [T-1 ~> s-1] type(tracer_type), pointer :: Tr=>NULL() integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Idt = 0.; if (dt/=0.) Idt = 1.0 / dt ! The "if" is in case the diagnostic is called for a zero length interval @@ -779,7 +779,7 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) real :: work2d(SZI_(G),SZJ_(G)) type(tracer_type), pointer :: Tr=>NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then Tr => Reg%Tr(m) @@ -811,10 +811,8 @@ subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) integer, intent(in) :: ntr !< number of registered tracers type(ocean_grid_type), intent(in) :: G !< ocean grid structure - integer :: is, ie, js, je, nz - integer :: i, j, k, m + integer :: m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do m=1,ntr call hchksum(Tr(m)%t, mesg//trim(Tr(m)%name), G%HI) enddo @@ -822,9 +820,10 @@ subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) end subroutine MOM_tracer_chksum !> Calculates and prints the global inventory of all tracers in the registry. -subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) +subroutine MOM_tracer_chkinv(mesg, G, GV, h, Tr, ntr) character(len=*), intent(in) :: mesg !< message that appears on the chksum lines type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(:), intent(in) :: Tr !< array of all of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses integer, intent(in) :: ntr !< number of registered tracers @@ -834,7 +833,7 @@ subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) integer :: is, ie, js, je, nz integer :: i, j, k, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do m=1,ntr do k=1,nz ; do j=js,je ; do i=is,ie tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 44c6c2e5a1..9d0b5e4f74 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -191,7 +191,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & integer :: nzdata if (.not.associated(CS)) return - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB h_neglect = GV%H_subroundoff @@ -307,7 +307,7 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, real :: in_flux(SZI_(G),SZJ_(G),2) ! total amount of tracer to be injected integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 8f00b0d5b9..f6d98b1f0f 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -250,10 +250,10 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS if (CS%Z_IC_file) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, name,& - G, US, -1e34, 0.0) ! CS%land_val(m)) + G, GV, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, & - trim(name), G, US, -1e34, 0.0) ! CS%land_val(m)) + trim(name), G, GV, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) call MOM_error(FATAL,"initialize_ideal_age_tracer: "//& "Unable to read "//trim(name)//" from "//& trim(CS%IC_file)//".") diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index c07f1c03e4..12427b7c37 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -265,10 +265,10 @@ subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & if (CS%Z_IC_file) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, name, & - G, US, -1e34, 0.0) ! CS%land_val(m)) + G, GV, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, & - trim(name), G, US, -1e34, 0.0) ! CS%land_val(m)) + trim(name), G, GV, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) call MOM_error(FATAL,"initialize_oil_tracer: "//& "Unable to read "//trim(name)//" from "//& trim(CS%IC_file)//".") diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 5465d5fcea..48708794fd 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -98,7 +98,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 923801db2d..46425cbb0d 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -114,7 +114,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -245,7 +245,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, character(len=40) :: verticalCoordinate real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -303,9 +303,9 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, case ( REGRIDDING_LAYER ) - delta_S = S_range / ( G%ke - 1.0 ) + delta_S = S_range / ( GV%ke - 1.0 ) S(:,:,1) = S_ref - do k = 2,G%ke + do k = 2,GV%ke S(:,:,k) = S(:,:,k-1) + delta_S enddo @@ -317,7 +317,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Modify salinity and temperature when z coordinates are used if ( coordinateMode(verticalCoordinate) == REGRIDDING_ZSTAR ) then - index_bay_z = Nint ( dome2d_depth_bay * G%ke ) + index_bay_z = Nint ( dome2d_depth_bay * GV%ke ) do j = G%jsc,G%jec ; do i = G%isc,G%iec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then @@ -332,20 +332,20 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,1:G%ke) = S_ref + S_range; ! Use for sigma coordinates - T(i,j,1:G%ke) = 1.0; ! Use for sigma coordinates + S(i,j,1:GV%ke) = S_ref + S_range; ! Use for sigma coordinates + T(i,j,1:GV%ke) = 1.0; ! Use for sigma coordinates endif enddo ; enddo endif ! Modify temperature when rho coordinates are used - T(G%isc:G%iec,G%jsc:G%jec,1:G%ke) = 0.0 + T(G%isc:G%iec,G%jsc:G%jec,1:GV%ke) = 0.0 if (( coordinateMode(verticalCoordinate) == REGRIDDING_RHO ) .or. & ( coordinateMode(verticalCoordinate) == REGRIDDING_LAYER )) then do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - T(i,j,G%ke) = 1.0 + T(i,j,GV%ke) = 1.0 endif enddo ; enddo endif @@ -381,7 +381,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC real :: dummy1, x, z integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(param_file, mdl, "DOME2D_WEST_SPONGE_TIME_SCALE", dome2d_west_sponge_time_scale, & @@ -463,7 +463,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC enddo enddo ; enddo ! Store the grid on which the T/S sponge data will reside - call initialize_ALE_sponge(Idamp, G, param_file, ACSp, h, nz) + call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index f92d2d7ac6..e994518eff 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -105,7 +105,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -168,7 +168,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed eta(:,:,:) = 0.0 ; temp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 @@ -281,7 +281,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) type(OBC_segment_type), pointer :: segment => NULL() type(tracer_type), pointer :: tr_ptr => NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index d125495d7f..4ffe8bdc35 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -157,7 +157,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -285,7 +285,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi real :: drho_dT1 ! A prescribed derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] real :: drho_dS1 ! A prescribed derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: T_Ref, S_Ref - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pres(:) = 0.0 just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -462,7 +462,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) character(len=40) :: mdl = "ISOMIP_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, "Minimum layer thickness", & @@ -589,7 +589,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. - call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) + call initialize_ALE_sponge(Idamp, G, GV, PF, ACSp, h, nz) dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 227c814b3c..0a46fb260d 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -194,7 +194,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) real :: val1, val2, sina, cosa type(OBC_segment_type), pointer :: segment => NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index da181c5eca..daedacf4b2 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -369,9 +369,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Allocate and initialize ! a. Stokes driftProfiles - allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke)) CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke)) CS%Us_y(:,:,:) = 0.0 ! b. Surface Values allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) @@ -385,7 +385,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) CS%La_turb (:,:) = 0.0 ! d. Viscosity for Stokes drift if (CS%StokesMixing) then - allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) + allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,GV%ke)) CS%KvS(:,:,:) = 0.0 endif @@ -502,7 +502,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) IIm1 = max(1,II-1) Bottom = 0.0 MidPoint = 0.0 - do kk = 1,G%ke + do kk = 1,GV%ke Top = Bottom MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) @@ -515,7 +515,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) JJm1 = max(1,JJ-1) Bottom = 0.0 MidPoint = 0.0 - do kk = 1,G%ke + do kk = 1,GV%ke Top = Bottom MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) @@ -549,7 +549,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo ! 2. Second compute the level averaged Stokes drift bottom = 0.0 - do kk = 1,G%ke + do kk = 1,GV%ke Top = Bottom IIm1 = max(II-1,1) MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) @@ -592,7 +592,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo ! Compute the level averages. bottom = 0.0 - do kk = 1,G%ke + do kk = 1,GV%ke Top = Bottom JJm1 = max(JJ-1,1) MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) @@ -624,7 +624,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do II = G%isdB,G%iedB do jj = G%jsd,G%jed bottom = 0.0 - do kk = 1,G%ke + do kk = 1,GV%ke Top = Bottom IIm1 = max(II-1,1) MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) @@ -642,7 +642,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isd,G%ied do JJ = G%jsdB,G%jedB Bottom = 0.0 - do kk=1, G%ke + do kk=1, GV%ke Top = Bottom JJm1 = max(JJ-1,1) MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) @@ -664,7 +664,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) DHH85_is_set = .true. endif else! Keep this else, fallback to 0 Stokes drift - do kk= 1,G%ke + do kk= 1,GV%ke do II = G%isdB,G%iedB do jj = G%jsd,G%jed CS%Us_x(II,jj,kk) = 0. @@ -921,7 +921,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & endif ContinueLoop = .true. bottom = 0.0 - do kk = 1,G%ke + do kk = 1,GV%ke Top = Bottom MidPoint = Bottom + GV%H_to_Z*0.5*h(kk) Bottom = Bottom + GV%H_to_Z*h(kk) @@ -933,7 +933,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & endif if (WaveMethod==TESTPROF) then - do kk = 1,G%ke + do kk = 1,GV%ke US_H(kk) = 0.5*(WAVES%US_X(I,j,kk)+WAVES%US_X(I-1,j,kk)) VS_H(kk) = 0.5*(WAVES%US_Y(i,J,kk)+WAVES%US_Y(i,J-1,kk)) enddo @@ -1238,7 +1238,7 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) ! This is a template to think about down-Stokes mixing. ! This is not ready for use... - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do I = G%iscB, G%iecB h_lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i+1,j,k)) @@ -1248,7 +1248,7 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) (waves%us_x(i,j,k-1)-waves%us_x(i,j,k)) / & (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i+1,j,k-1)) )) dTauDn = 0.0 - if (k < G%ke-1) & + if (k < GV%ke-1) & dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1)) * & (waves%us_x(i,j,k)-waves%us_x(i,j,k+1)) / & (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i+1,j,k+1)) )) @@ -1257,7 +1257,7 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) enddo enddo - do k = 1, G%ke + do k = 1, GV%ke do J = G%jscB, G%jecB do i = G%isc, G%iec h_Lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i,j+1,k)) @@ -1267,7 +1267,7 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) (waves%us_y(i,j,k-1)-waves%us_y(i,j,k)) / & (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i,j+1,k-1)) )) dTauDn = 0.0 - if (k < G%ke-1) & + if (k < GV%ke-1) & dTauDn =0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1)) * & (waves%us_y(i,j,k)-waves%us_y(i,j,k+1)) / & (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i,j+1,k+1)) )) @@ -1303,7 +1303,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES, US) real :: DVel ! A rescaled velocity change [m s-1 T-1 ~> m s-2] integer :: i,j,k - do k = 1, G%ke + do k = 1, GV%ke do j = G%jsc, G%jec do I = G%iscB, G%iecB DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & @@ -1313,7 +1313,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES, US) enddo enddo - do k = 1, G%ke + do k = 1, GV%ke do J = G%jscB, G%jecB do i = G%isc, G%iec DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index d019854310..4c095c0b63 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -264,7 +264,7 @@ subroutine Neverworld_initialize_thickness(h, G, GV, US, param_file, eqn_of_stat character(len=40) :: mdl = "Neverworld_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call MOM_mesg(" Neverworld_initialization.F90, Neverworld_initialize_thickness: setting thickness", 5) call get_param(param_file, mdl, "INIT_THICKNESS_PROFILE", h_profile, & diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index dd7309265f..6bbe429248 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -58,7 +58,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par character(len=40) :: mdl = "Phillips_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed eta_im(:,:) = 0.0 @@ -139,7 +139,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p integer :: i, j, k, is, ie, js, je, nz, m logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -233,7 +233,7 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz logical, save :: first_call = .true. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed eta(:,:,:) = 0.0 ; temp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 70b9fcd4dc..6fbe90b855 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -48,10 +48,10 @@ module RGC_initialization !> Sets up the the inverse restoration time, and the values towards which the interface heights, !! velocities and tracers should be restored within the sponges for the RGC test case. subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and !! salinity or mixed layer density. @@ -93,7 +93,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, iscB, iecB, jscB, jecB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB @@ -181,8 +181,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) call pass_var(h, G%domain) - !call initialize_ALE_sponge(Idamp, h, nz, G, PF, ACSp) - call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) + call initialize_ALE_sponge(Idamp, G, GV, PF, ACSp, h, nz) ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%T) ) then diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 1238944a60..4e27227da6 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -54,7 +54,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -129,7 +129,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & character(len=40) :: verticalCoordinate real :: PI ! 3.1415926... calculated as 4*atan(1) - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -189,7 +189,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 9f36e7033d..1d426be636 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -76,7 +76,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 0ceaabbec7..66cbf7e72d 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -61,7 +61,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read #include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -220,7 +220,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index b1977b3fdd..4415f6bcae 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -96,7 +96,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f real :: PI ! 3.1415926... calculated as 4*atan(1) logical :: just_read ! If true, just read parameters but set nothing. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params call bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index cc82ea6761..243e31bc4d 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -126,7 +126,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state character(len=40) :: mdl = "benchmark_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version, "") @@ -242,7 +242,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index eb7f765890..4dd5a7c606 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -31,7 +31,7 @@ module circle_obcs_initialization subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_params) 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. @@ -50,7 +50,7 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 468a5649fe..9c9952a102 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -249,7 +249,7 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CS enddo enddo - call initialize_ALE_sponge(Idamp, G, param_file, ACSp, h, nz) + call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) ! construct temperature and salinity for the sponge ! start with initial condition diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 2b2b8b46c6..c0979def10 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -114,7 +114,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -228,7 +228,7 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file logical :: dbrotate ! If true, rotate the domain. character(len=20) :: verticalCoordinate, density_profile - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -366,7 +366,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, enddo enddo ; enddo - call initialize_ALE_sponge(Idamp, G, param_file, ACSp, h, nz) + call initialize_ALE_sponge(Idamp, G, GV, param_file, ACSp, h, nz) ! construct temperature and salinity for the sponge ! start with initial condition diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index da4751b3fa..4c633ebdc9 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -131,12 +131,13 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) end subroutine dyed_channel_set_OBC_tracer_data !> This subroutine updates the long-channel flow -subroutine dyed_channel_update_flow(OBC, CS, G, Time) +subroutine dyed_channel_update_flow(OBC, CS, G, GV, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(dyed_channel_OBC_CS), pointer :: CS !< Dyed channel 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. type(time_type), intent(in) :: Time !< model time. ! Local variables character(len=40) :: mdl = "dyed_channel_update_flow" ! This subroutine's name. @@ -166,7 +167,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) else flow = G%US%m_s_to_L_T*CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) endif - do k=1,G%ke + do k=1,GV%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then segment%normal_vel(I,j,k) = flow diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index 39519ce8a6..0307d93d3d 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -45,7 +45,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) type(OBC_segment_type), pointer :: segment => NULL() type(tracer_type), pointer :: tr_ptr => NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 2ef3ca2fb7..96a5ec40d0 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -47,7 +47,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re integer :: i, j, k, is, ie, js, je, nz real :: PI, Xnondim - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 1a3e8dd308..d56605aa63 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -47,7 +47,7 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea character(len=40) :: mdl = "lock_exchange_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 0df24efb42..684f22fb0a 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -99,7 +99,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -210,7 +210,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate, density_profile - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 928c8ae223..7ab923dfea 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -13,6 +13,7 @@ module shelfwave_initialization use MOM_open_boundary, only : OBC_registry_type use MOM_time_manager, only : time_type, time_type_to_real use MOM_unit_scaling, only : unit_scale_type +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -125,14 +126,15 @@ subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) end subroutine shelfwave_initialize_topography !> This subroutine sets the properties of flow at open boundary conditions. -subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies +subroutine shelfwave_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(shelfwave_OBC_CS), pointer :: CS !< tidal bay control structure. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(shelfwave_OBC_CS), pointer :: 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_(G)), intent(in) :: h !< layer thickness. - type(time_type), intent(in) :: Time !< model time. + type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the shelfwave example. real :: my_amp, time_sec diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 5136775918..4a91435cb6 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -79,7 +79,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p integer :: i, j, k, is, ie, js, je, nx, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version, "") @@ -203,7 +203,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's ! name. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -221,10 +221,10 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file if (just_read) return ! All run-time parameters have been read, so return. ! Prescribe salinity - !delta_S = S_range / ( G%ke - 1.0 ) + !delta_S = S_range / ( GV%ke - 1.0 ) !S(:,:,1) = S_ref - !do k = 2,G%ke + !do k = 2,GV%ke ! S(:,:,k) = S(:,:,k-1) + delta_S !enddo @@ -239,14 +239,14 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file enddo ; enddo ! Prescribe temperature - delta_T = T_range / ( G%ke - 1.0 ) + delta_T = T_range / ( GV%ke - 1.0 ) T(:,:,1) = T_ref - do k = 2,G%ke + do k = 2,GV%ke T(:,:,k) = T(:,:,k-1) + delta_T enddo kdelta = 2 - T(:,:,G%ke/2 - (kdelta-1):G%ke/2 + kdelta) = 1.0 + T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = 1.0 end subroutine sloshing_initialize_temperature_salinity diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 4351060fb8..4d75a25695 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -40,7 +40,7 @@ subroutine soliton_initialize_thickness(h, G, GV, US) real :: val1, val2, val3, val4 character(len=40) :: verticalCoordinate - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call MOM_mesg("soliton_initialization.F90, soliton_initialize_thickness: setting thickness") @@ -63,8 +63,9 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, h, G, US) +subroutine soliton_initialize_velocity(u, v, h, G, GV, US) type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] @@ -79,7 +80,7 @@ subroutine soliton_initialize_velocity(u, v, h, G, US) real :: val4 ! The local velocity amplitude [L T-1 ~> m s-1] integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke x0 = 2.0*G%len_lon/3.0 y0 = 0.0 diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 19aacab72d..12a31f3a75 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -23,12 +23,13 @@ module supercritical_initialization contains !> This subroutine sets the properties of flow at open boundary conditions. -subroutine supercritical_set_OBC_data(OBC, G, param_file) - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies - !! whether, where, and what open boundary - !! conditions are used. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(param_file_type), intent(in) :: param_file !< Parameter file structure +subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. real :: zonal_flow ! Inflow speed [L T-1 ~> m s-1] @@ -52,7 +53,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) if (segment%is_E_or_W) then jsd = segment%HI%jsd ; jed = segment%HI%jed IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB - do k=1,G%ke + do k=1,GV%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then segment%normal_vel(I,j,k) = zonal_flow diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 67999fff40..f2efc4cefc 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -60,14 +60,15 @@ subroutine tidal_bay_OBC_end(CS) 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, 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(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. +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(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_(G)), intent(in) :: h !< layer thickness. - type(time_type), intent(in) :: Time !< model time. + type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the tidal_bay example. real :: time_sec, cff @@ -79,7 +80,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index a63e7a2b89..222bc1b6f2 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -80,7 +80,7 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i real :: dt_fill ! timestep used to fill massless layers character(len=200) :: mesg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (.not.associated(CS)) call MOM_error(FATAL,"user_set_diffusivity: "//& diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index a5d0fc90f7..671663fd74 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -105,8 +105,9 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine USER_initialize_thickness !> initialize velocities. -subroutine USER_initialize_velocity(u, v, G, US, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -135,8 +136,9 @@ 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, param_file, eqn_of_state, just_read_params) +subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, just_read_params) 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_(G)), intent(out) :: T !< Potential temperature [degC]. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt]. type(param_file_type), intent(in) :: param_file !< A structure indicating the @@ -188,7 +190,7 @@ subroutine USER_initialize_sponges(G, GV, use_temp, tv, param_file, CSp, h) end subroutine USER_initialize_sponges !> This subroutine sets the properties of flow at open boundary conditions. -subroutine USER_set_OBC_data(OBC, tv, G, param_file, tr_Reg) +subroutine USER_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. @@ -197,6 +199,7 @@ subroutine USER_set_OBC_data(OBC, tv, G, param_file, tr_Reg) !! temperature and salinity or mixed layer density. Absent !! fields have NULL ptrs. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values.